paste this code into a standard module
i assume dept names start at F4, since rows 1-3 are being replicated?

Option Explicit
Sub moveCopy()
Dim text As String
Dim cells As Range
Dim wb As Workbook
Dim ws As Worksheet
Dim rowindex As Long

Do While Range("F4") < ""
text = Range("F4")
With ActiveSheet
Set cells = Columns(5).cells.Find(text)
Do While Not cells Is Nothing
If wb Is Nothing Then
Set wb = Workbooks.Add()
Set ws = wb.ActiveSheet
.Range("1:3").Copy
ws.Range("A1").PasteSpecial xlValues
rowindex = 4
End If

.Rows(cells.Row).Copy
ws.cells(rowindex, 1).PasteSpecial xlValues
rowindex = rowindex + 1
.Rows(cells.Row).Delete
Set cells = .cells.Find(text)
Loop
If Not wb Is Nothing Then
wb.SaveAs text
wb.Close False
Set wb = Nothing
Set ws = Nothing
End If
End With
Loop


End Sub


"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.