paste into new sheets

[Guest]

hi,

lets say i have a sheet with like 40 rows in it. i want to group the rows
by account number. so i am curious if there is any code i could write to
group the account numbers, and then to see if there
is code i can write to put each different group into a new sheet.

thanks in advance,
geebee

 

[JW]

This contains ho error handling. So, if there is a sheet already
existing with the same name as one of the unique records in your
filter column, you will receive an error. A simple check could be
added to se if a sheet already exists.

To filter on a different column, simply change the FilterColumnLetter
variable to the letter of the column you want to filter on. I know it
looks like a lot of code, but the vast majority of it is declaring and
setting variables.

Sub ReportSplit()
Dim shSource As Worksheet, shTarget As Worksheet
Dim rgSource As Range, rgUniques As Range
Dim cl As Range
Dim BotRow As Long
Dim FilterColumnLetter As String
Dim Uniques As Collection
Dim Unique As Variant
Set shSource = ActiveWorkbook.ActiveSheet
Set Uniques = New Collection
FilterColumnLetter = "B"
BotRow = Cells(65536, _
FilterColumnLetter).End(xlUp).Row
With shSource
Set rgSource = .UsedRange
Set rgUniques = .Range(FilterColumnLetter & "2:" _
& FilterColumnLetter & BotRow)
End With
On Error Resume Next
For Each cl In rgUniques
Uniques.Add cl.Value, CStr(cl.Value)
Next cl
On Error GoTo 0
Application.ScreenUpdating = False
For Each Unique In Uniques
Worksheets.Add after:=ActiveSheet
Set shTarget = ActiveSheet
shTarget.Name = Unique
With rgSource
.Columns(FilterColumnLetter).AutoFilter 1, Unique
.Copy shTarget.Range("A1")
End With
shSource.AutoFilterMode = False
Next Unique
shSource.Activate
Application.ScreenUpdating = True
Set Uniques = Nothing
Set shSource = Nothing
Set rgSource = Nothing
Set rgUniques = Nothing
Set shTarget = Nothing
End Sub

 

[Guest]

hi,

thanks... could you add some comments to the lines of code so that i know
what each line is doing? i am stil learning, so this would be helpful.

thanks in advance,
geebee

 

[JW]

Sub ReportSplit()
'declaring variables
Dim shSource As Worksheet, shTarget As Worksheet
Dim rgSource As Range, rgUniques As Range
Dim cl As Range
Dim BotRow As Long
Dim FilterColumnLetter As String
Dim Uniques As Collection
Dim Unique As Variant
'set variable = to active worksheet
Set shSource = ActiveWorkbook.ActiveSheet
'set variable = to new collection
'used for storing the unique values
Set Uniques = New Collection
'establish the column to filter on
FilterColumnLetter = "B"
'find the last row in the filter column
BotRow = Cells(65536, _
FilterColumnLetter).End(xlUp).Row
'with the sheet set as the shSource vaiable
With shSource
'set variable = to the sheets used range
Set rgSource = .UsedRange
'set variable = to the filter column range
Set rgUniques = .Range(FilterColumnLetter & "2:" _
& FilterColumnLetter & BotRow)
End With
On Error Resume Next
'add all uniqe records from the filter column
'to the collection
For Each cl In rgUniques
Uniques.Add cl.Value, CStr(cl.Value)
Next cl
On Error GoTo 0
'turns screen updating off
'so you don't get the flickering screen
Application.ScreenUpdating = False
'cycles through the unique values
'applying the filter for each one
For Each Unique In Uniques
'adds a new sheet to place the filtered data
Worksheets.Add after:=ActiveSheet
'set variable = to the newly added sheet
Set shTarget = ActiveSheet
'names the sheet the same value that
'is currently being used as the filter criteria
shTarget.Name = Unique
'actually applying the filter to the filter column
With rgSource
.Columns(FilterColumnLetter).AutoFilter 1, Unique
'copying the filtered data to the new sheet
.Copy shTarget.Range("A1")
End With
'turning off the autofilter
shSource.AutoFilterMode = False
Next Unique
'activating the original sheet
shSource.Activate
'turns screen updating back on
Application.ScreenUpdating = True
'clearing memory
Set Uniques = Nothing
Set shSource = Nothing
Set rgSource = Nothing
Set rgUniques = Nothing
Set shTarget = Nothing
End Sub

 

[Ron de Bruin]

See also
http://www.rondebruin.nl/copy5.htm