excel - 数据透视表过滤器没有数据 VBA

Question

我有 VBA 代码，它将数据透视表中的过滤数据放入工作表中的单独选项卡中。一切正常，直到由于没有任何数据而无法通过 Initials 过滤数据。我在下面尝试了一个 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

标签： excelvba