Copy subtotal results

[Len]

Hi,

Below is the scenario which need to run the data sorting, subtotalling
and the result shows only the subtotal and grandtotal rows after
closing the side filter panel.
Is there any excel formula or VB code to copy only the subtotal cells
from the respective rows ( ie, B7, B13, B17, B20, B22, B26 & B27 )
into sheet2 and not the whole range being copied over which is not
needed : -


A B
1 1 4,084.20
2 1 300.00
3 1 450.00
4 1 3,965.00
5 1 200.00
6 1 50.00
7 2 47.00
8 2 1,037.20
9 2 750.00
10 2 0.60
11 2 16,200.00
12 3 400.00
13 3 640.00
14 3 302.00
15 4 475.00
16 4 321.00
17 5 258.00
18 6 3,457.00
19 6 2.00
20 6 378.00

The Results
A B
7 1 Total 4,965.00
13 2 Total 18,034.80
17 3 Total 1,342.00
20 4 Total 796.00
22 5 Total 258.00
26 6 Total 3,837.00
27 GrandTotal 29,232.80


Please help, thanks

Regards
Len

 

[Stefi]

First: Your result is wrong, because you doesn't have a heading in row 1.
Check your subtotal for 1 in column A! The right result is 9049.20 (Your
calculation missed the first element 40084.20: 9049.20 - 40084.20 = 4965.00).
Make a heading, recalculate subtotals, the try this sub:
Sub subtotcopy()
Selection.CurrentRegion.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
End Sub

Regards,
Stefi

„Len†ezt írta:

 

[Len]

First: Your result is wrong, because you doesn't have a heading in row 1.
Check your  subtotal for 1 in column A! The right result is 9049.20 (Your
calculation missed the first element 40084.20: 9049.20 - 40084.20 = 4965..00).
Make a heading, recalculate subtotals, the try this sub:
Sub subtotcopy()
    Selection.CurrentRegion.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub

Regards,
Stefi

„Len” ezt írta:











- Show quoted text -

Hi Stefi,

Oppp........ the heading is missing and the result is incorrect
After recalculating the data and running subtotal function, apply your
VB code and it works !

Thanks

Regards
Len

 

[Stefi]

You are welcome! Thanks for the feedback!
Stefi

„Len†ezt írta: