Фильтр сводной таблицы не имеет данных VBA

Question

У меня есть код VBA, который помещает отфильтрованные данные из сводной таблицы в отдельные вкладки на рабочем листе. Все работает нормально, пока не сможет отфильтровать данные по инициалам, потому что нет никаких данных. Я попробовал оператор if ниже, но это не сработало - почесал голову («Сводная таблица фильтра»).

Sub ReportCreation(Initials As String, Name As String)

Debug.Print Initials
Debug.Print Name

'Delete old Sales Reps Sheets
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets(Initials).Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Copies the Sales Template to new Tab
ActiveWorkbook.Sheets("SalesTemplate").Copy after:=ActiveWorkbook.Sheets("SalesTemplate")
ActiveSheet.Name = Initials

'Add Sales Reps Name to Report
ActiveSheet.Cells.Range("A4").Value = Name

'Filter Pivot Table
Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Pivot Table").PivotTables("PivotTable1").ManualUpdate = True
ActiveWorkbook.Sheets("Pivot Table").PivotTables("PivotTable1").PivotFields("Rep.").ClearAllFilters
With ActiveWorkbook.Sheets("Pivot Table").PivotTables("PivotTable1").PivotFields("Rep.").CurrentPage = Initials
If CurrentPage = 0 Then Resume Next Else CurrentPage = Initials
End With
ActiveWorkbook.Sheets("Pivot Table").PivotTables("PivotTable1").ManualUpdate = False
Application.ScreenUpdating = True

'Copy Pivot Table results to new Sales Rep tab
ActiveWorkbook.Sheets("Pivot Table").Select
Range("A4:F4").Select
'Rows("4:5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(Initials).Select
Range("A7").Select
ActiveSheet.Range("A7").PasteSpecial Paste:=xlPasteValues

Sorting (Initials)

End Sub