1

I have multiple pivot tables in different work sheets in excel (1 per worksheet). I would like to copy them all to a new worksheet but I want them to be below one another with a 2 row gap between each.

I have the code to copy a table from one worksheet to another, but I cannot figure out how to copy another to the same worksheet without pasting it over the previous table....

'Copy table 1
Sheet1.PivotTables(1).TableRange2.Copy
With Sheet7.Range(Sheet1.PivotTables(1).TableRange2.Address)
    .PasteSpecial xlPasteValuesAndNumberFormats
    .PasteSpecial xlPasteColumnWidths
End With
Application.CutCopyMode = False

Each pivot table can be dynamic in height (and width) and so the offset for the subsequent table will be dependent on the size of the previous one....

Does anyone have any idea how to implement this?

JimmyPena
  • 8,694
  • 6
  • 43
  • 64
user559142
  • 12,279
  • 49
  • 116
  • 179
  • Find the last row using this code http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba and then paste the next pivot after that. – Siddharth Rout Jul 16 '12 at 20:44
  • How do I modify the above code to paste at a specific point? – user559142 Jul 16 '12 at 20:56
  • Past the 1st table in Row 1 and then find the last row. Add 2 to it. Paste the next table in that row. Find the last row again. Add 2 to it. Paste the next table in that row. Repeat process till the time all tables have been pasted. – Siddharth Rout Jul 16 '12 at 20:59

1 Answers1

0
Sub CopyPT()

Dim rngDest As Range
Dim sht As Worksheet, tr As Range

    Set rngDest = Sheet7.Range("B2")

    For Each sht In ThisWorkbook.Worksheets

        If sht.Name <> Sheet7.Name Then
            If sht.PivotTables.Count = 1 Then
                Set tr = sht.PivotTables(1).TableRange2
                'Debug.Print sht.Name, tr.Rows.Count
                tr.Copy
                With rngDest
                    .PasteSpecial xlPasteValuesAndNumberFormats
                    .PasteSpecial xlPasteColumnWidths
                End With
                Set rngDest = rngDest.Offset(tr.Rows.Count + 2, 0)
            End If
        End If

    Next sht

    Application.CutCopyMode = False

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125