EliseFreedman
Programmer
I am trying to create individual workbooks for each manager from a master workbook. Each workbook will contain 3 pivot tables on a single sheet.
I am using the following code.
My problem is that the pivot table just gets copied and pasted in as values. Ideally I want the actual pivot table. I have tried other ways of accomplishing this like using Pivot table pages - It was getting messy since it just created all the sheets in the one workbook. Has anyone got any suggestions?
I am using the following code.
My problem is that the pivot table just gets copied and pasted in as values. Ideally I want the actual pivot table. I have tried other ways of accomplishing this like using Pivot table pages - It was getting messy since it just created all the sheets in the one workbook. Has anyone got any suggestions?
Code:
Option Explicit
Sub GetAllEmployeeSelections2()
Const filePath As String = "H:\Reports\" 'save location for new files
Dim wb As Workbook
Dim ws As Worksheet
Dim pvt As PivotTable
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Summary")
Set pvt = ws.PivotTables("PivotTable1")
Application.ScreenUpdating = False
Dim pvtField As PivotField
Dim item As Variant
Set pvtField = pvt.PivotFields("Mgr")
pvtField.ClearAllFilters
pvtField.CurrentPage = "(All)"
For Each item In pvtField.PivotItems
item.Visible = True
Next item
pvt.ShowPages "Mgr"
For Each item In pvtField.PivotItems
Dim newBook As Workbook
Set newBook = Workbooks.Add
With newBook
.Worksheets(1).Name = item.Name
wb.Worksheets(item.Name).UsedRange.Copy
Worksheets(item.Name).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.SaveAs FileName:=filePath & item.Name & ".xlsx"
.Close
End With
Set newBook = Nothing
Next item
Application.DisplayAlerts = False
For Each item In pvtField.PivotItems
wb.Worksheets(item.Name).Delete
Next item
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub