hi
i wrote a sub to copy the sub totals but it keys on my data. i was wanted to
key it to your data. works pretty good. the if statement below keys on my
data. you will need to change it to fit your data. post back if you have
problems.

Sub copysubtotals()
Dim r As Range
Dim rd As Range
Set r = Range("B2")
Do While Not IsEmpty(r)
Set rd = r.Offset(1, 0)
If r.Offset(0, -1).Value = "" Then
Range(r, r.Offset(0, 3)).Copy
Sheets("Sheet3").Range("A65000").End(xlUp). _
Offset(1, 0).PasteSpecial xlPasteValues
End If
Set r = rd
Loop
End Sub

regards
FSt1

"Stephen" wrote:

I think I found my answer...

ActiveSheet.Outline.ShowLevels RowLevels:=2
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.Copy
Sheets("Totals").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("D:G").Delete
Range("A1").Select

ThisWorkbook.Worksheets("Receives").Select
ActiveSheet.Outline.ShowLevels RowLevels:=3

Columns("A:A").EntireColumn.AutoFit
Range("A1").Select

MsgBox "Operation completed successfully."

This seems to work fine. BUT I realized that column "B" is blank on these
subtotal rows. Is there a way I can 'copy values to empty cells below filled
cells in selection' before I copy them to the 'Totals' sheet?? I know this
is a function that is included in ASAP Utilities, but I would like to
incorporate this function into my macro.

???

"FSt1" wrote:

hi,
how is your data layed out? Post 4 or 5 lines or enough to subtotal on.
need something to key on.

regards
FSt1

"Stephen" wrote:

Hi Folks,

I have a sheet (Receives) that generates a dataset based on date parameters
from a different sheet (Date Selection), then subtotals column "E" of the
dataset at each change in column "A". That works like a charm.

I need to be able to copy only the subtotal rows to a third sheet but I
would like those copied rows to paste sequentially to row 1,2,3, etc. - does
that make sence?

Here is what I have so far...

Sub Receives()

ThisWorkbook.Worksheets("Receives").Select
Range("A2").Select
Selection.RemoveSubtotal

Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False

Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

ActiveSheet.Outline.ShowLevels RowLevels:=2
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Font.Bold = False
Selection.Font.Bold = True
ActiveSheet.Outline.ShowLevels RowLevels:=3

Columns("A:A").EntireColumn.AutoFit
Range("A1").Select

MsgBox "Operation completed successfully."

End Sub

I would like to have code prior to the Msgbox that would copy subtotals to
sheet three.

TIA!