Trying to take four pivot tables and copy specific columns from each into its own row in a table on a new sheet. I'm spinning in circles. So far, this is what I have below
For each row in each pivot table, I need the macro to copy the "rngList" and transpose on the table in column E creating 12 new rows. On each of the new rows, Field Names [Accounting Structure], [Dimension Values], [Amount Type] from the PivotTable needs to be copied over to the table in columns F, G, & J respectively. Then each new row needs the data copied over from each of the 12 Value Columns "Sum of MMM-24". Once one row in pivot table is copied, it needs to go through the rest of that pivot table and then complete the same actions for the other three pivot tables.
Examples of PivotTables to be copied and the Table data will be pasted into below as well.
For each row in each pivot table, I need the macro to copy the "rngList" and transpose on the table in column E creating 12 new rows. On each of the new rows, Field Names [Accounting Structure], [Dimension Values], [Amount Type] from the PivotTable needs to be copied over to the table in columns F, G, & J respectively. Then each new row needs the data copied over from each of the 12 Value Columns "Sum of MMM-24". Once one row in pivot table is copied, it needs to go through the rest of that pivot table and then complete the same actions for the other three pivot tables.
Examples of PivotTables to be copied and the Table data will be pasted into below as well.
VBA Code:
Private Sub CommandButton8_Click()
Dim tbl As ListObject
Set tbl = Worksheets("Dynamics Budget Upload").ListObjects("DynamicsBudgetUpload")
Dim GPT As PivotTable, MaintPT As PivotTable, FBPT As PivotTable, GAPT As PivotTable
Set GPT = Worksheets("GPivot").PivotTable("GPivot")
Set MaintPT = Worksheets("Maintenance Pivot").PivotTable("Maintenance Pivot")
Set FBPT = Worksheets("F&B Pivot").PivotTable("F&B Pivot")
Set GAPT = Worksheets("G&A Pivot").PivotTable("G&A Pivot")
GPT.RowAxisLayout xlTabularRow
MaintPT.RowAxisLayout xlTabularRow
FBPT.RowAxisLayout xlTabularRow
GAPT.RowAxisLayout xlTabularRow
Dim rngList As Range
Set rngList = Worksheets("GPivot").Range("D5:O5")
On Error GoTo ErrorMessage
With GPT
With tbl
ErrorMessage:
MsgBox "An error has occurred: " & Err.Description
Resume ExitSub
End Sub
Last edited by a moderator: