Split data into new sheets

[Guest]

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.

 

[Papparotti]

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

 

[Guest]

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

 

[Ron de Bruin]

Hi bernard

Look here
http://www.rondebruin.nl/copy5.htm

 

[Guest]

Ron

It works a treat! Thanks!

Bernard

Hi bernard

Look here
http://www.rondebruin.nl/copy5.htm