Copying subtotals only

[K. Georgiadis]

I have sorted a data base and created Subtotals, using Data>Subtotals. Then I collapsed the data so that only the subtotals are visible.

As the next step, I want to create a Lookup table in a different worksheet, displaying exclusively the Subtotals from the previous worksheet. I started creating the lookup table by pointing to the first row of Subtotals from the data base but, obviously, I cannot simply drag the formula down because of the hidden rows in the data table.

Is there a routine to copy the subtotals ONLY, so as to creeate a contiguous vlookup table, other than the old and tiresome
point-and-click method?

[lucas]

I think you can copy the visable cells only:
To copy just these rows and omit the rows that are hidden, we must select only the visisble rows. Excel provides us with that function under Edit>Goto (F5). The Goto dialog has a Special button on the bottom left:
That button brings up the Go To Special dialog box. On that dialog, choose Visible cells only. Then just copy and paste normally.

[K. Georgiadis]

It should work as long as the cells remain linked to the subtotals. In retrospect, I don't think that I explained adequately that the data base is dynamic and that the "pasted" cells (which are going to become part of a vlookup table) also need to update themselves with every workbook edit.

[mdmackillop]

Hi K.
Give this a try. It finds the Total rows and creates a formula reference on sheet2 back to each cell
[vba]
Option Explicit
Option Compare Text

Sub GetTotals()
Dim c As Range
Dim FirstAddress As String
With Worksheets(1).Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
Set c = .Find("Total", LookIn:=xlValues, Lookat:=xlPart)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
CopyData c
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Sheets(2).Activate
End Sub

Sub CopyData(c As Range)
Dim dest As Range, source As Range, cel As Range
Dim sh As String
Dim i As Long
Set dest = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
Set source = Range(c, c.End(xlToRight))
sh = ActiveSheet.Name
i = 0
For Each cel In source
dest.Offset(, i).Formula = "=" & sh & "!" & cel.Address(0, 0)
i = i + 1
Next
End Sub

[/vba]

[K. Georgiadis]

Thank you very much, I'll give it a try.