Hi bernard

How many different accounts are in the list (more or less than 250)???

below some code that I use to split files by account numbers where the
user has to select a cell within the column that contains the account
number...

Hope this helps

Regards

Papparotti

Dim bSh As Worksheet 'original sheet - baseSheet
Dim AccCol As Integer 'column containing the account number
Dim maxRows As Integer
Dim maxCols As Integer
Dim i As Integer
Dim tmpName As String
Dim tmpName2 As String

Application.ScreenUpdating = False

AccCol = ActiveCell.Column

Set bSh = ActiveSheet
maxRows = bSh.UsedRange.Rows.Count - 1
maxCols = bSh.UsedRange.Columns.Count

For i = maxRows To 8 Step -1 'The copy process starts with the
last line

tmpName = Cells(i, AccCol).Text
tmpName2 = Cells(i, NameCol).Text

If Not findSheet(tmpName) Then 'The code for findSheet is
below!

Worksheets.Add
after:=Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Name = tmpName
ActiveSheet.Cells.Interior.Color = RGB(255, 255, 255)
'The following lines copy header information to the newly
created sheet
bSh.Activate
bSh.Range(Cells(1, 1), Cells(7, maxCols + 1)).Copy 'AMEND
TO FIT FILE
Worksheets(tmpName).Activate
ActiveSheet.Cells(1, 1).PasteSpecial (xlAll)
'end of header copying
End If

bSh.Activate

Cells(i, 2).EntireRow.Select
Selection.Copy
Worksheets(tmpName).Activate
Rows("8:8").Select 'you'll have to amend this
according to your headers
Selection.Insert Shift:=xlDown

bSh.Activate
Next i


Application.ScreenUpdating = True

End Sub

Private Function findSheet(ByVal sName As String) As Boolean
Dim s As Variant
For Each s In ActiveWorkbook.Worksheets
If s.Name = sName Then
findSheet = True
Exit Function
End If
Next s
findSheet = False
End Function