software

I have a (very) long list, sorted by account code. I would like to write a
macro that splits the list into separate sheets in the workbook, with a
separate sheet for each account code.

Ideally, I would also like to rename each sheet to show which account code
the sheet contains.

I have no idea, though, where to start. Any ideas? Thanks in advance.

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 -gt; 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(quot;8:8quot;).Select 'you'll have to amend this
according to your headers
Selection.Insert Shift:=xlDown

bSh.Activate
Next iApplication.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 FunctionThanks for this - I think I can see what this is doing (I am still at the
very early stages with VB!) but I can't quite get it to work. For example,
Visual Basic has hilgihted the following line in red:
'after:=Worksheets(ActiveWorkbook.Worksheets.Count )'. Any ideas?

Don't know if it helps at all, but my spreadsheet has 3 columns - Code,
Description and Amount and the header row is in line 4.

Thanks again.

quot;Papparottiquot; wrote:

gt; Hi bernard
gt;
gt; How many different accounts are in the list (more or less than 250)???
gt;
gt; below some code that I use to split files by account numbers where the
gt; user has to select a cell within the column that contains the account
gt; number...
gt;
gt; Hope this helps
gt;
gt; Regards
gt;
gt; Papparotti
gt;
gt; Dim bSh As Worksheet 'original sheet -gt; baseSheet
gt; Dim AccCol As Integer 'column containing the account number
gt; Dim maxRows As Integer
gt; Dim maxCols As Integer
gt; Dim i As Integer
gt; Dim tmpName As String
gt; Dim tmpName2 As String
gt;
gt; Application.ScreenUpdating = False
gt;
gt; AccCol = ActiveCell.Column
gt;
gt; Set bSh = ActiveSheet
gt; maxRows = bSh.UsedRange.Rows.Count - 1
gt; maxCols = bSh.UsedRange.Columns.Count
gt;
gt; For i = maxRows To 8 Step -1 'The copy process starts with the
gt; last line
gt;
gt; tmpName = Cells(i, AccCol).Text
gt; tmpName2 = Cells(i, NameCol).Text
gt;
gt; If Not findSheet(tmpName) Then 'The code for findSheet is
gt; below!
gt;
gt; Worksheets.Add
gt; after:=Worksheets(ActiveWorkbook.Worksheets.Count)
gt; ActiveSheet.Name = tmpName
gt; ActiveSheet.Cells.Interior.Color = RGB(255, 255, 255)
gt; 'The following lines copy header information to the newly
gt; created sheet
gt; bSh.Activate
gt; bSh.Range(Cells(1, 1), Cells(7, maxCols 1)).Copy 'AMEND
gt; TO FIT FILE
gt; Worksheets(tmpName).Activate
gt; ActiveSheet.Cells(1, 1).PasteSpecial (xlAll)
gt; 'end of header copying
gt; End If
gt;
gt; bSh.Activate
gt;
gt; Cells(i, 2).EntireRow.Select
gt; Selection.Copy
gt; Worksheets(tmpName).Activate
gt; Rows(quot;8:8quot;).Select 'you'll have to amend this
gt; according to your headers
gt; Selection.Insert Shift:=xlDown
gt;
gt; bSh.Activate
gt; Next i
gt;
gt;
gt; Application.ScreenUpdating = True
gt;
gt; End Sub
gt;
gt; Private Function findSheet(ByVal sName As String) As Boolean
gt; Dim s As Variant
gt; For Each s In ActiveWorkbook.Worksheets
gt; If s.Name = sName Then
gt; findSheet = True
gt; Exit Function
gt; End If
gt; Next s
gt; findSheet = False
gt; End Function
gt;
gt;

Hi bernard

Look here
www.rondebruin.nl/copy5.htm
--
Regards Ron de Bruin
www.rondebruin.nlquot;bernardquot; gt; wrote in message ...
gt;I have a (very) long list, sorted by account code. I would like to write a
gt; macro that splits the list into separate sheets in the workbook, with a
gt; separate sheet for each account code.
gt;
gt; Ideally, I would also like to rename each sheet to show which account code
gt; the sheet contains.
gt;
gt; I have no idea, though, where to start. Any ideas? Thanks in advance.
Ron

It works a treat! Thanks!

Bernard

quot;Ron de Bruinquot; wrote:

gt; Hi bernard
gt;
gt; Look here
gt; www.rondebruin.nl/copy5.htm
gt;
gt;
gt;
gt; --
gt; Regards Ron de Bruin
gt; www.rondebruin.nl
gt;
gt;
gt; quot;bernardquot; gt; wrote in message ...
gt; gt;I have a (very) long list, sorted by account code. I would like to write a
gt; gt; macro that splits the list into separate sheets in the workbook, with a
gt; gt; separate sheet for each account code.
gt; gt;
gt; gt; Ideally, I would also like to rename each sheet to show which account code
gt; gt; the sheet contains.
gt; gt;
gt; gt; I have no idea, though, where to start. Any ideas? Thanks in advance.
gt;
gt;
gt;