枢轴宏不起作用

Question

我制作了一个以前正在工作的宏（如下所示），并突然停止工作。它正在创建数据透视表，但现在已停止这样做。我看不到会导致此问题的任何更改。当我调试它时，没有错误，当我查看“本地”时，我看到它正在捕获行和列。是什么原因导致宏停止创建数据透视表？

Dim PRange As Range 'Source data range
Dim lastRow As Long 'Last Row of Report even if it changes
Dim lastCol As Long 'Last Column of Report even if it changes
Dim DSheet As Worksheet 'Claiming "Report" sheet as data sheet
Dim PSheet As Worksheet 'Claiming what is pivot sheet for this macro
Dim ptType As String

'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Reclass").Delete
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Reclass"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Reclass")
Set DSheet = Worksheets("Report")
    With ActiveWorkbook.Sheets("Reclass").Tab
        .Color = 8988
        .TintAndShade = 0
    End With

'Defining Data Range. Taking the first cell of the data table and select uptp the last row and then up to the last column
    lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = DSheet.Cells(7, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(7, 1).Resize(lastRow, lastCol)

'Create pivot cache. Defines Pivot Cache by using Data source and defines the cell address in the new worksheet to insert pivot table
    Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="ReclassPush")

'Insert Pivot Table
    Set pt = pc.CreatePivotTables(TableDestination:=PSheet.Cells(2, 2), TableName:="ReclassPush")

'Putting Row Fields in
    With ActiveSheet.pivotTable("ReclassPush").PivotFields("PO Requestor")
        .Orientation = xlRowField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("ReclassPush").PivotFields("Reason")
        .Orientation = xlRowField
        .Position = 2
    End With
        ActiveSheet.PivotTables("ReclassPush").CompactLayoutRowHeader = "Orginal PO Requester"

    With ActiveSheet.PivotTables("NonReclass").PivotFields("PO Requestor")
        .Orientation = xlRowField
        .Position = 1
    End With

'Putting Values Field in
 ActiveSheet.PivotTables("ReclassPush").AddDataField ActiveSheet.PivotTables( _
        "ReclassPush").PivotFields("Func Currency Amt"), "Sum of Func Currency Amt", _
        xlSum


'Putting Filter Fields in: Adds reclass filter to pivot table and shows only PO Requestors who needed their JE to be Reclassed
    With ActiveSheet.PivotTables("ReclassPush").PivotFields("Reclass Flag")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("ReclassPush").PivotFields("Reclass Flag"). _
        ClearAllFilters
    ActiveSheet.PivotTables("ReclassPush").PivotFields("Reclass Flag"). _
        CurrentPage = "Y"

有关注释的编辑代码：

Option Explicit
'Macro is makes list of users who submitted reclasses through the adjustments tool as well well as the reason why for the reclass

Sub MakeAPivotTable()

Dim pt As pivotTable 'Creates pivot table
Dim pc As PivotCache 'Pivot Cache
Dim pf As PivotField 'Pivot Field
Dim pi As PivotItem
Dim PRange As Range 'Source data range
Dim lastRow As Long 'Last Row of Report even if it changes
Dim lastCol As Long 'Last Column of Report even if it changes
Dim DSheet As Worksheet 'Claiming "Report" sheet as data sheet
Dim PSheet As Worksheet 'Claiming what is pivot sheet for this macro
Dim ptType As String

'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Reclass").Delete
On Error GoTo 0
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Reclass"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Reclass")
Set DSheet = Worksheets("Report")
    With ActiveWorkbook.Sheets("Reclass").Tab
        .Color = 8988
        .TintAndShade = 0
    End With

'Defining Data Range. Taking the first cell of the data table and select uptp the last row and then up to the last column
    lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    lastCol = DSheet.Cells(7, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(7, 1).Resize(lastRow, lastCol)

'Create pivot cache. Defines Pivot Cache by using Data source and defines the cell address in the new worksheet to insert pivot table
    Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="ReclassPush")

'Insert Pivot Table
    Set pt = pc.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="ReclassPush")

'Putting Row Fields in
    With ActiveSheet.PivotTables("ReclassPush").PivotFields("PO Requestor")
        .Orientation = xlRowField
        .Position = 1
    End With

    With ActiveSheet.PivotTables("ReclassPush").PivotFields("Reason")
        .Orientation = xlRowField
        .Position = 2
    End With
        ActiveSheet.PivotTables("ReclassPush").CompactLayoutRowHeader = "Orginal PO Requester"

    With ActiveSheet.PivotTables("NonReclass").PivotFields("PO Requestor")
        .Orientation = xlRowField
        .Position = 1
    End With

'Putting Values Field in
 ActiveSheet.PivotTables("ReclassPush").AddDataField ActiveSheet.PivotTables( _
        "ReclassPush").PivotFields("Func Currency Amt"), "Sum of Func Currency Amt", _
        xlSum


'Putting Filter Fields in: Adds reclass filter to pivot table and shows only PO Requestors who needed their JE to be Reclassed
    With ActiveSheet.PivotTables("ReclassPush").PivotFields("Reclass Flag")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("ReclassPush").PivotFields("Reclass Flag"). _
        ClearAllFilters
    ActiveSheet.PivotTables("ReclassPush").PivotFields("Reclass Flag"). _
        CurrentPage = "Y"



    ActiveSheet.PivotTables("ReclassPush").ColumnGrand = False
    Range("B4").Select

    'Tabular Form
     ActiveSheet.PivotTables("ReclassPush").PivotFields("PO Requestor").LayoutForm _
        = xlTabular

      Columns("D:D").Select
    Selection.Style = "Comma"
End Sub