2 versions:
Version 1 with use of loops to select pivottable items.
Version 2 using .ShowPages
method of pivottable.
I am guessing method 1 should be more efficient.
In an initial couple of runs, with nothing else running, I was surprised to see the .ShowPages
was quicker; with an average 2.398
seconds, versus version 1, which took 3.263
seconds.
Caveat: This was only a few test runs for timing, and there may be differences due to my coding, but maybe worth exploring? No other optimization methods used. There are others, of course, possible.
Version 1:
Option Explicit
Sub GetAllEmployeeSelections()
Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files
Dim wb As Workbook
Dim ws As Worksheet
Dim pvt As PivotTable
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet3")
Set pvt = ws.PivotTables("PivotTable1")
Application.ScreenUpdating = False
Dim pvtField As PivotField
Dim item As Long
Dim item2 As Long
Set pvtField = pvt.PivotFields("SPerson")
For item = 1 To pvtField.PivotItems.Count
pvtField.PivotItems(item).Visible = True
For item2 = 1 To pvtField.PivotItems.Count
If item2 <> item Then pvtField.PivotItems(item2).Visible = False
Next item2
Dim newBook As Workbook
Set newBook = Workbooks.Add
With newBook
Dim currentName As String
currentName = pvtField.PivotItems(item).Name
.Worksheets(1).Name = currentName
pvt.TableRange2.Copy
Worksheets(currentName).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.SaveAs Filename:=filePath & currentName & ".xlsx"
.Close
End With
Set newBook = Nothing
Next item
Application.ScreenUpdating = True
End Sub
Version2:
Why not leverage the .ShowPages
method of PivotTable
and have your sPerson
as the page field argument? It loops the pagefield
specified and generates a sheet for each item with that item's value. You can then loop again the fields items and export the data to new workbooks, save, and then delete the created sheets.
It is probably a bit overkill!
PivotTable.ShowPages Method (Excel)
Creates a new PivotTable report for each item in the page field. Each
new report is created on a new worksheet.
Syntax
expression . ShowPages( PageField )
expression A variable that represents a PivotTable object.
Code:
Option Explicit
'Requires all items selected
Sub GetAllEmployeeSelections2()
Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files
Dim wb As Workbook
Dim ws As Worksheet
Dim pvt As PivotTable
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet3")
Set pvt = ws.PivotTables("PivotTable1")
Application.ScreenUpdating = False
Dim pvtField As PivotField
Dim item As Variant
Set pvtField = pvt.PivotFields("SPerson")
pvtField.ClearAllFilters
pvtField.CurrentPage = "(All)"
For Each item In pvtField.PivotItems
item.Visible = True
Next item
pvt.ShowPages "Employee"
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