vba - Loop Pivot Table Filter based on values in column

Question

very new to this but I'll try to make my question simple to understand.

I have an Excel sheet with a pivot table which I filter through the first column (sales persons names) one by one, and then copy-pasting the filtered pivot table to a new worksheet and saving it as the sales persons name.

Is it possible to get a macro to loop through the first columns filter based on values in a table (Table1) and copy the values out to a new worksheet? An example of the macro would be helpful.

Update - I've managed something to some degree, but it is copying the pivottable wholesale, and then trying to save a file with each row.

Sub Gen()

Dim PvtTbl As PivotTable
Set PvtTbl = ActiveSheet.PivotTables("PivotTable1")
Dim Field As PivotField
Set Field = ActiveSheet.PivotTables("PivotTable1").PivotFields("SPerson")
Dim PvtItm As PivotItem
Dim Range As Range
Dim i As Long
Dim var As Variant


Application.ScreenUpdating = False


For Each PvtItm In Field.PivotItems
    ActiveSheet.Range("$A$11").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs ("C:" & ActiveSheet.Range("$B$2") & Format(Date, "yyyy - mm") & ".xlsx")
Next PvtItm


Application.ScreenUpdating = True


End Sub`

Where $A$11 is the pivottable and $B$2 is the name of the salesperson I want to save the file as.

Answer 1

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:UsersUserDesktop" '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:UsersUserDesktop" '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