View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel[_861_] joel[_861_] is offline
external usenet poster
 
Posts: 1
Default Macro to copy subtotaled data


Try this code. The code copies rows so it doesn't care the number of
columns. All it looks at is column A to get the Client Name and looks
for the word "Total" in column A to determine where each subtotal ends.


Sub SplitSubtotal()

'assume there is a header row which gets copied to each new sheet

Set Sourcesht = Sheets("Sheet1")

With Sourcesht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'ignore the Grand Total line if one exists
If InStr(UCase(.Range("A" & LastRow)), "GRAND") 0 Then
LastRow = LastRow - 1
End If

StartRow = 2
RowCount = StartRow
For RowCount = StartRow To LastRow
If InStr(UCase(.Range("A" & RowCount)), "TOTAL") 0 Then
client = .Range("A" & StartRow)
'create new sheet
Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
'changge sheet name to clients name
newsht.Name = client
'copy header row
.Rows(1).Copy Destination:=newsht.Rows(1)
'copy data
.Rows(StartRow & ":" & RowCount).Copy _
Destination:=newsht.Rows(2)
StartRow = RowCount + 1
End If

Next RowCount

End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=193510

http://www.thecodecage.com/forumz