I have a pivot table I am trying to filter based on an array value and copy that filtered data to a worksheet that has the same name as the array filter then go back to the pivot table and select the next value in the array and copy that data into the worksheet of the same name. I can't get it to select the data to copy. Pivot table worksheet is called "Dept Transaction Listing" and the worksheets are called "BkHireDPC", "BusTech" and "BusMgtServices" respectively. This is only a sample of the overall database. The full database has approx. 24 different worksheets that make up the array. I get a 1004 runtime error on the VisibleItemsList code.
My code so far is:
Sub CopyPivotDatatoCCWSheets()
' *************************************************************************************************************
' Goes through each worksheet in the array and copies pivot table data for each cost centre to
' their respective worksheets
' Author:
' Date Created:
' Date Modified:
' *************************************************************************************************************
Dim WshtNames As Variant
Dim WshtNamebyCC As Variant
Dim PvtTbl As PivotTable
Set PvtTbl = Worksheets("Dept Transaction Listing").PivotTables("PivotTable1")
'Turns screen updating off
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.ErrorCheckingOptions.BackgroundChecking = True
'Copies pivot table section to worksheet
WshtNames = Array("BkHireDPC", "BusTech", "BusMgtServices")
For Each WshtNamebyCC In WshtNames
With Worksheets(WshtNamebyCC)
'select the PivotTable data you want to copy
PvtTbl.PivotFields("WSValue").ClearAllFilters
PvtTbl.PivotFields("WSValue").VisibleItemsList = Array("WshtNamebyCC")
Selection.Copy
'select the worksheet where you want the PivotTable to be pasted:
Worksheets("WshNamebyCC").Select
'paste the selected PivotTable to the selected worksheet:
Worksheets("WshNamebyCC").Range("A5").End(xlDown).Offset(5, 0).PasteSpecial
End With
Sheets(WshtNamebyCC).Activate
' Loops to next worksheet
Next WshtNamebyCC
' At end of loop returns to Dept Transaction Listing worksheet
Worksheets("Dept Transaction Listing").Select
Range("A1").Select
' Turns screen updating on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.ErrorCheckingOptions.BackgroundChecking = False
End Sub
Where am I going wrong?
Bookmarks