PDA

View Full Version : Subtotals using Macro ...



JohnyG
06-17-2008, 04:07 AM
Hi,

Need a help. I have the following code that picks the subtotal (Sheet4) and paste in (sheet5)...

Sub CopySubTotals()
Dim Src As Worksheet, Tgt As Worksheet, R1 As Range, R2 As Range

Set Src = Sheets("Sheet4")
Set Tgt = Sheets("Sheet5")
Src.Outline.ShowLevels 3
Set R1 = Src.Range("B1").End(xlDown)
Do
Set R2 = Tgt.Range("A" & Tgt.Rows.Count).End(xlUp).Offset(1)
R2 = R1
R2.Offset(, 1) = R1.Offset(1, 1)
R2.Offset(, 2) = R1.Offset(1, 2)
R2.Offset(, 2) = R1.Offset(1, 5)
Set R1 = R1.End(xlDown).End(xlDown)
Loop While R1.Row < Src.Rows.Count
End Sub

Now the issue is at certain stage for example ... Row 29 sheet5 it started picking wrong values and instead of subtotals the macro starts picking other values. Effectively it started from row 776 (sheet4)...

Can someone please help me on this ..

Regards,

JimmyTheHand
06-17-2008, 04:38 AM
Wasn't taken into consideration that list of a company can be 1 rows high.
Try this:
Sub CopySubTotals()
Dim Src As Worksheet, Tgt As Worksheet, R1 As Range, R2 As Range

Set Src = Sheets("Sheet4")
Set Tgt = Sheets("Sheet5")
Src.Outline.ShowLevels 3
Set R1 = Src.Range("B1").End(xlDown)
On Error Resume Next
Do
Set R2 = Tgt.Range("A" & Tgt.Rows.Count).End(xlUp).Offset(1)
R2 = R1
R2.Offset(, 1) = R1.Offset(1, 1)
R2.Offset(, 2) = R1.Offset(1, 2)
R2.Offset(, 2) = R1.Offset(1, 5)

Set R1 = R1.End(xlDown)
If R1.Offset(1) <> "" Then Set R1 = R1.End(xlDown)
Loop While R1.Row < Src.Rows.Count
End Sub


Jimmy

JohnyG
06-17-2008, 05:30 AM
Thank you sir..

That did the needful..

Regards,