I'm trying to create a macro that will copy multiple pivot tables side by side with varying length (or rows) on more than one worksheet in a workbook, and paste them one after another onto a new worksheet within that workbook.
The pivot tables have the same number of columns from the different data source and are filtered based on certain criteria that vary among each pivot table.
The reason I want to copy each pivot table to a worksheet is because I want to compare the collective data from the pivot tables to all of the data from the data source to capture any data that may not appear on the pivot tables (to catch any exceptions).
I know I can cut and paste the data from the pivot tables and compare to the data source to get what I need, but I am hoping to avoid having to cut and paste the data from each pivot table. That's where the macro/vba I am looking for would be helpful.
i came across below code which is working perfectly but the issue is that it paste the pivot tables it self not data of table, so i am not able to do any thing over it .
what i need is that it should paste the values and formatting instead of table
below is the code :
Sub Test()
'Makes code run faster
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'For Regular OD PTP
For i = 1 To 1
LR = Sheets("Test").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Regular OD PTP").Activate
Sheets("Regular OD PTP").PivotTables("PivotTable" & i).PivotSelect "", xlDataAndLabel, False
Selection.Copy
Sheets("Test").Activate
Sheets("Test").Range("A" & LR + 2).Select
ActiveSheet.Paste
Next i
'For OLD OD PTP pivot Sheet
For i = 6 To 6
LR = Sheets("Test").Range("A" & Rows.Count).End(xlUp).Row
Sheets("OLD OD PTP pivot").Activate
Sheets("OLD OD PTP pivot").PivotTables("PivotTable" & i).PivotSelect "", xlDataAndLabel, False
Selection.Copy
Sheets("Test").Activate
Sheets("Test").Range("A" & LR + 2).Select
ActiveSheet.Paste
Next i
'Formatting pivot tables for column adjustment
numCol = Sheets("Test").UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
letcol = Replace(Cells(1, numCol).Address(False, False), "1", "")
Sheets("Test").Activate
ActiveSheet.Columns("A:" & letcol).AutoFit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Please Help
Neeraj
Bookmarks