Ron to the rescue again: thank you!

It does just what I need. I've tweaked it to suit folder location and
file name conventions here, but nothing you did not already expect.
I've also added a find/replace in the new workbooks to capture line
breaks that transformed into odd characters when copied to the new
workbook - searches for Char(10) and replaces it with Char(10). That
seems to clean it up.

Here's the final macro

Sub Copy_To_Workbooks()

   Dim CalcMode As Long
   Dim ws1 As Worksheet
   Dim ws2 As Worksheet
   Dim WSNew As Worksheet
   Dim rng As Range
   Dim cell As Range
   Dim Lrow As Long
   Dim foldername As String
   Dim MyPath As String
   Dim FieldNum As Integer
   Dim FileExtStr As String
   Dim FileFormatNum As Long

   Application.StatusBar = "Creating workbooks. Please wait..."
   Application.ScreenUpdating = False

' Name of the sheet with your data
   Set ws1 = Sheets("CustomKFCDonation")

' Determine the Excel version and file extension/format
   If Val(Application.Version) < 12 Then
       'You use Excel 97-2003
       FileExtStr = ".xls": FileFormatNum = -4143
   Else
       'You use Excel 2007
       If ws1.Parent.FileFormat = 56 Then
           FileExtStr = ".xls": FileFormatNum = 56
       Else
           FileExtStr = ".xlsx": FileFormatNum = 51
       End If
   End If

' Set filter range : A1 is the top left cell of your filter range and
' the header of the first column, D is the last column in the filter
range
   Set rng = ws1.Range("A1:AP" & Rows.Count)

' Set Field number of the filter column
' This example filters on the first field in the range(change the
field if needed)
' In this case the range starts in A so Field:=1 is column A, 2 =
column B, ......
   FieldNum = 1
   With Application
       CalcMode = .Calculation
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
   End With

' Add worksheet to copy/Paste the unique list
   Set ws2 = Worksheets.Add

' Fill in the path\folder where you want the new folder with the files
   MyPath = "Y:\Communications\Online Fundraising\Tribute\2008\"

' Add a slash at the end if the user forget it
   If Right(MyPath, 1) <> "\" Then
       MyPath = MyPath & "\"
   End If

' Create folder for the new files
   foldername = MyPath & Format(Now, "yyyy-mm-dd hh-mm-ss") & "\"
   MkDir foldername

   With ws2
' first we copy the Unique data from the filter field to ws2
       rng.Columns(FieldNum).AdvancedFilter _
               Action:=xlFilterCopy, _
               CopyToRange:=.Range("A1"), Unique:=True

' loop through the unique list in ws2 and filter/copy to a new
workbook
       Lrow = .Cells(Rows.Count, "A").End(xlUp).Row

       For Each cell In .Range("A2:A" & Lrow)
           'Add new workbook with one sheet
           Set WSNew = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Firstly, remove the AutoFilter
           ws1.AutoFilterMode = False

' Filter the range
           rng.AutoFilter Field:=FieldNum, Criteria1:="=" &
cell.Value

' Copy the visible data and use PasteSpecial to paste to the new
worksheet
           ws1.AutoFilter.Range.Copy

           With WSNew.Range("A1")
               ' Paste:=8 will copy the columnwidth in Excel 2000 and
higher
               .PasteSpecial Paste:=8
               .PasteSpecial xlPasteValues
               .PasteSpecial xlPasteFormats
               Application.CutCopyMode = False
               .Select
           End With

' Save the file in the new folder and close it
           WSNew.Parent.SaveAs foldername & cell.Value & "_" &
Format(Now(), "yyyy_mmdd") _
                               & FileExtStr, FileFormatNum

' Replaces odd line break character with new line breaks
          Cells.Replace What:=Chr(10), Replacement:=Chr(10),
LookAt:=xlPart, SearchOrder _
           :=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False

' Changes dates stored as numbers to dates
           Columns("D:D").Select
           Selection.NumberFormat = "m/d/yyyy"

' Changes numbers stored as text to numbers
           Columns("F:F").Select
           For Each xCell In Selection
           xCell.Value = xCell.Value
               Next xCell

' saves the workbook with changes
           WSNew.Parent.Save
           WSNew.Parent.Close False
           'Close AutoFilter
           ws1.AutoFilterMode = False

       Next cell

       'Delete the ws2 sheet
       On Error Resume Next
       Application.DisplayAlerts = False
       .Delete
       Application.DisplayAlerts = True
       On Error GoTo 0

   End With

   MsgBox "Look in " & foldername & " for the files"

   With Application
       .ScreenUpdating = True
       .Calculation = CalcMode
       .StatusBar = False
   End With
End Sub

Steven