Macro to change filter on Pivot Table and paste results in new sheet

mdanger217

New Member
Joined
May 16, 2018
Messages
3
I am trying to create a macro for the following scenario.

I have a workbook with two tabs, one with data on phone calls and the other with a pivot table of the data in the first sheet. The pivot table has two filters (Date and Type), in the rows I have a list of phone numbers and in the values I have a the count of how many times they call on said date (changes with the filter). In the second sheet, I also have a set of formulas linked to the first sheet with all the data and the pivot table. The idea is that when I change the date filter in the pivot table everything updates at once. Up to this point I have everything working how I want it to.

I have 165 dates in the pivot table and I want to make a macro that will copy the values from the formulas I have made (cells G7:G17), paste them in a new sheet as values, then change the filter to the next date and repeat for all dates, but this time pasting the range next to the previously pasted range.

For example, for 01/01/2018 it would copy cells G7:G17 and paste them as values in a new sheet say in cells B2:B12, then it would change the pivot table date filter to 02/01/2018 (or whichever date is next), copy cells G7:G17 and paste as values in the new sheet in cells C2:C12 (always one column to the right) and so on and so on.

To clarify, cells G7:G17 are not in the pivot table and contain the formulas that I have made. The second filter in the pivot table (type) must not be changed – I only need the macro to change the date filter.

I hope that makes sense. I have recorded a macro but when I edit it I can’t get the loop to work correctly (it always pastes in the same cells – B2:B12) and the filter in the pivot table always remains the same. I am new to VBA but I am much more competent with the formula side of Excel.

Thank you so much in advance!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
So far this is the code that I have written - a mixture of running a macro, finding code online that will help, and tweaking it to my needs:

Code:
Sub PivotTablePaste()



Dim PvtTbl As PivotTable
Dim pvtItm As PivotItem
Dim lastCol As Long


lastCol = Cells(2, Columns.Count).End(xlToLeft).Column + 1


Set PvtTbl = Worksheets("PT").PivotTables("PivotTable1")


For Each pvtItm In PvtTbl.PivotFields("Date").PivotItems


   Sheets("PT").Range("G7:G17").Copy
    Sheets("Result").Select
    
    Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


Next




End Sub

At the moment it is not cycling through the filter and it is only pasting in the same range.

PT is the sheet where the pivot table is
Result is where I want the values to be pasted side by side

I'd really appreciate any help with this :)
 
Upvote 0
This is where I am at:

Code:
Sub PivotTablePaste()

Dim PvtTbl As PivotTable
Dim PvtItm As PivotItem
Dim PvtFld As PivotField
Dim LastCol As Long


Set PvtTbl = Worksheets("PT").PivotTables("PivotTable1")
Set PvtFld = PvtTbl.PivotFields("Date")


For Each PvtItm In PvtFld.PivotItems


LastCol = Cells(2, Columns.Count).End(xlToLeft).Column


   Sheets("PT").Range("G7:G17").Copy
    Sheets("Result").Select
    
    Cells(2, LastCol + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


Next


End Sub

I have managed to get the values to paste how and where I want them. The problem is that instead of looping through the filter in the pivot table, it is copying and pasting the same date x times (x is how many dates I have in my filter).

Thanks
 
Upvote 0

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top