PDA

View Full Version : Copy several pivot tables to new worksheet



Johnatha
01-06-2016, 12:11 PM
Hello,

I'm trying to create a macro that will copy multiple pivot tables and paste them one after another, onto a new worksheet. This is what I have so far:


Sub CopyPivotTable()
Dim ws As Worksheet
Set ws = Worksheets.Add
Sheets("Pivot Table Sheet").Select
ActiveSheet.PivotTables("PivotTable2").PivotSelect "", xlDataAndLabel, True
Selection.Copy
ws.Range("A1").PasteSpecial xlPasteValues

End Sub

It works for 1 pivot table, but I'm not sure what the code should be for the next pivot table.

Thank you in advance :)
-Johnathan

Johnatha
01-06-2016, 12:35 PM
Found the solution! :)

Sub CopyPivotTable()
Dim ws As Worksheet
Set ws = Worksheets.Add
Dim Last_Row As Long
Last_Row = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Pivot Table Sheet").Select
ActiveSheet.PivotTables("PivotTable2").PivotSelect "", xlDataAndLabel, True
Selection.Copy
ws.Range("A1").PasteSpecial xlPasteValues
Sheets("Pivot Table Sheet").Select
ActiveSheet.PivotTables("PivotTable12").PivotSelect "", xlDataAndLabel, True
Selection.Copy
ws.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub