Here is a macro I wrote a long time ago which splits data from a single sheet
into separate sheets. Paste all the code into a VBA module, then un-split any
lines which wrapped when posted in the forum.

Sub SplitData()
'Extracts data for multiple entities (customers, brands, ??)
'from a master sheet to a separate sheet for each entity.
'Requirements (assumptions in the code):
'1. ENTITY NAME/ID IS IN KEY COLUMN
'2. SHEET HAS HEADINGS IN ONE ROW ONLY
'3. THERE IS A HEADING FOR EVERY COLUMN WITH DATA
'4. MASTER DATA SHEET IS ACTIVE WHEN MACRO IS RUN
'----------------------------------------------------------
'To use this macro:
'A) Open this file.
'B) Open the Excel file with the data. Make sure the correct
' sheet is active.
'C) Run the SplitData macro.
'----------------------------------------------------------
'Set values for constants
Const HdgRow = 1
Const KeyCol = "A"
On Error GoTo SDerr1
'Declare variables.
Dim CurrCell As Object, BaseSht As String
Dim a As Integer, x As Integer
Dim CurrID As String, PrevID As String
Dim EndCol As Integer, KeyColNbr As Integer
Dim LastCell As Range, RowsLeft As Long
'Make sure this is not the active workbook.
If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "The workbook with the data to be split must be active.
Please make sure that " & _
"workbook is showing and click any cell on it to ensure it is
the active workbook.", _
vbInformation, "SplitData"
Exit Sub
End If
'Store the name of the starting sheet
BaseSht$ = ActiveSheet.Name
Range(KeyCol & (HdgRow + 1)).Activate
a% = ActiveCell.Row
'Assign the first entity ID as PrevID (so have a value to compare).
PrevID$ = ActiveCell.Value
'Find the last used cell (farthest to the right & down) on the sheet.
Set LastCell = Sheets(BaseSht$).Range(FindLastCell(Sheets(BaseSht $)))
RowsLeft& = LastCell.Row
EndCol% = LastCell.Column
'Find the last data column (with a heading).
'EndCol% = Cells(HdgRow, Columns.Count).End(xlToLeft).Column
'Get the number of the KeyCol
KeyColNbr% = Columns(KeyCol).Column
'Sort the data by the KeyCol.
Range(Cells(HdgRow, KeyColNbr%), LastCell).Select
Selection.Sort Key1:=Cells(HdgRow + 1, KeyColNbr%), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal
'Go to first row of data in key column.
Range(KeyCol & (HdgRow + 1)).Activate
'Walk down column and test value of every cell. Stop when row number
'is greater than RowsLeft&.
Do While ActiveCell.Row <= RowsLeft&
Set CurrCell = Cells(a%, KeyColNbr%)
CurrCell.Activate
CurrCell.Select
CurrID$ = CurrCell.Value
'Check if the value of the current cell (CurrID$) is the same as the
'previous row (PrevID$). If it's not the same, copy cols 1 through
'EndCol% for all the PrevID$ rows (including row 1). Paste them onto
'a new sheet, then return to the original sheet (BaseSht$). Delete all
'the PrevID$ rows (but not row 1). Assign the new CurrID$ to PrevID$.
'Reset a% to 1 (first row; will then increment it).
If CurrID$ < PrevID$ Then
Range(Cells(1, 1), Cells(a% - 1, EndCol%)).Select
RowsLeft& = RowsLeft& - (Selection.Rows.Count - 1)
Selection.Copy
Sheets.Add
ActiveSheet.Paste
If Len(Cells(2, KeyColNbr%).Value) 0 Then
ActiveSheet.Name = Cells(2, KeyColNbr%).Value
End If
'Autofit all the columns.
Cells.Select
Cells.EntireColumn.AutoFit
Range("A2").Select
Sheets(BaseSht$).Activate
Range(Cells(2, 1), Cells(a% - 1, EndCol%)).Select
Selection.EntireRow.Delete
PrevID$ = CurrID$
a% = 1
End If
a% = a% + 1
Loop
'Return to the starting sheet.
Sheets(BaseSht$).Activate
Range("A2").Select
'If there is nothing in row 2, delete the sheet.
For a% = KeyColNbr% To EndCol%
CurrID$ = CurrID$ & Cells(2, a%).Value
Next a%
If Len(CurrID$) = 0 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
ElseIf Len(Cells(2, KeyColNbr%).Value) 0 Then
ActiveSheet.Name = Cells(2, KeyColNbr%).Value
End If
Cleanup1:
'Free object variables.
Set LastCell = Nothing
Set CurrCell = Nothing
SDerr1:
If Err.Number < 0 Then
msg1$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg1$, , "SplitData", Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Sub

Public Function FindLastCell(Wksht As Worksheet) As String
'Returns address of last cell used (highest row & col) on specified sheet
Dim LastRow As Long
Dim LastCol As Integer
On Error GoTo FLCerr1
With Wksht
LastRow = 0
LastCol = 0
LastRow& = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
LastCol% = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
End With
FindLastCell$ = Cells(LastRow&, LastCol%).AddressLocal
Exit Function
FLCerr1:
'Empty worksheet, or unknown error.
FindLastCell$ = "ERROR"
End Function

Hope this helps,

Hutch

"break one rpt into multiple rpts" wrote:

I have created an excel report with column headings and data for 500
individual banks. I would like to take this report, and create 500 separate
reports, one for each bank. Is this possible?
Thanks!