Is there a Macro for printing a pivot table per report filter to a combined PDF file

This is a problem I ran into a few years back, and there is no out-of-the-box solution. But it is fairly straightforward.

Basically, with each filter applied to the pivot table, you create a separate and temporary worksheet with a copy of the filtered table. Then Select all those temporary sheets and export them to a PDF.

The example below shows a Sub created to perform these actions. By creating a separate Sub, you can call it for different pivot tables and/or different filters as needed.

Option Explicit

Sub test()
    PTtoPDF Sheet3.PivotTables(1), "name"
End Sub

Sub PTtoPDF(ByRef pt As PivotTable, ByVal fieldName As String)
    '--- access the worksheet for the given pivot table
    Dim ws As Worksheet
    Set ws = pt.Parent
    
    '--- make sure the pivot table is up to date
    pt.PivotCache.Refresh
    
    '--- filter the pivot by the given field
    Dim pf As PivotField
    Set pf = pt.PivotFields(fieldName)
    
    '--- the pivot table is filtered for each name and a copy
    '    of that filtered table creates a (separate) new
    '    (temporary) worksheet. we'll create an array to hold
    '    the worksheet names so we can create the PDF
    Dim wsNames() As Variant
    Dim wsCount As Long
    wsCount = 0
    
    '--- stop the screen from updating to go faster
    Application.ScreenUpdating = False
    
    Dim pi As PivotItem
    For Each pi In pf.PivotItems
        pf.CurrentPage = pi.Name
        
        '--- copy the filtered PT to a new sheet and save the name
        With ThisWorkbook
            wsCount = wsCount + 1
            ReDim Preserve wsNames(1 To wsCount)
            ws.Copy After:=.Sheets(ws.Name)
            Dim newWS As Worksheet
            Set newWS = .Sheets(.Sheets(ws.Name).Index + 1)
            wsNames(wsCount) = newWS.Name
        End With
    Next pi
    
    ThisWorkbook.Sheets(wsNames).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                           Filename:="sample.pdf", _
                           Quality:=xlQualityStandard, _
                           IncludeDocProperties:=True, _
                           IgnorePrintAreas:=False, _
                           OpenAfterPublish:=True
                           
    '--- finally delete the temporary sheets
    '    (disable the Alerts so that Excel doesn't ask
    '    to delete each worksheet)
    Dim previousAlertState As Boolean
    previousAlertState = Application.DisplayAlerts
    Application.DisplayAlerts = False
    
    Dim sheetName As Variant
    For Each sheetName In wsNames
        ThisWorkbook.Sheets(sheetName).Delete
    Next sheetName
    
    '--- turn it back on
    Application.DisplayAlerts = previousAlertState
    Application.ScreenUpdating = True

End Sub

Create a temporary workbook with one sheet for each pivot table and create the PDF from that.

Option Explicit
Sub PrintAll()
    '
    ' PrintAll Macro
    ' Print activity table for all employees
    '
    Dim response
    response = MsgBox("Do you want to print the overview of all employees?", vbYesNo)
    If response = vbNo Then Exit Sub
       
    Dim pt As PivotTable, pf As PivotField, pi As PivotItem
    Dim wbPDF As Workbook, n As Integer, pdfName As String

    ' create temporary workbook
    Set wbPDF = Workbooks.Add(1)

    Set pt = ActiveSheet.PivotTables("PivotTable1")
    With pt
        .PivotCache.Refresh ' always refresh the table
        Set pf = .PivotFields("name")
        For Each pi In pf.PivotItems
            .PivotFields("name").CurrentPage = pi.Name
     
            ' now check whether the current page is indeed the desired one,
            ' if not, the page of that e,mployee is empty so don't print
             
            If .PivotFields("name").CurrentPage.Caption = pi.Caption Then
                n = n + 1
                If n > 1 Then
                    wbPDF.Sheets.Add after:=wbPDF.Sheets(n - 1)
                End If
                .TableRange2.Copy wbPDF.Sheets(n).Range("A1")
               
            Else
                MsgBox "Error selecting " & pi.Name, vbExclamation
            End If
        Next
    End With

    ' create pdf
    pdfName = "AllEmployees_" & Format(Now, "yyyymmdd_hhmmss") & ".pdf"
    wbPDF.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName
    wbPDF.Close False
    MsgBox "PDF created " & pdfName, vbInformation

End Sub