I might do it this way.

Option Explicit
Sub MakeWorkbooksFromUniqueList()
Dim lr, lc, lclr As Long
Dim c As Range
Application.ScreenUpdating = False
lr = Cells.Find(What:="*", After:=[A1], _
SearchDirection:=xlPrevious).Row - 3
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Cells(4, "f").Resize(lr).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, lc + 1), Unique:=True
lclr = Cells(Rows.Count, lc + 1).End(xlUp).Row
On Error Resume Next
For Each c In Cells(2, lc + 1).Resize(lclr - 1)
With Range("a4").Resize(lr, lc)
..AutoFilter Field:=6, Criteria1:=c
Range("a1").Resize(lr, lc).SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add Template:="Workbook"
With Range("A1")
.PasteSpecial Paste:=xlPasteColumnWidths
.PasteSpecial Paste:=xlPasteAll
.Select
End With
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
.AutoFilter
End With
Next c
Columns(lc + 1).Clear
Application.ScreenUpdating = True
End Sub
--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"George" wrote in message
...
Dear group members,

My need is to parse Excel file.
I have names of departments in F column:

aa
ab
ac
df
(et cetera, 30 departments)

I have list of departments and other information in my source Excel
file.
My task is:
1) copy three first lines of sheet "as is"
2) copy all strings with "aa" in F column,
3) paste to other Excel file and to save it as C:\destination\aa.xls

Then to do the same for "ab", "ac" and all the rest 30 departments.

Tell me please how do I perform this.
Thank you.