枢轴没有出现

Question

您好我有以下代码在工作表上执行此操作并从中创建数据透视表。我的问题是枢轴不会出现，空白表＆＃34; NoMilestonesPT＆＃34;出现，但它是空白的，没有表格。我有目的地遗漏了列和行值，如果我添加它们就无济于事。

任何人都可以看到可能出错的地方吗？

由于

    Sub projectsWithoutMilestone()




    'Insert a New Blank Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("NoMilestones").Delete
    Worksheets("SOWMilestoneList").Delete
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "NoMilestones"
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "SOWMilestoneList"
    Application.DisplayAlerts = True
    'Switch off error masking
    On Error GoTo 0

     Sheets("DemandTable").Select
    Range("Table_Demand458910[#All]").Select
    Selection.Copy
    Sheets("NoMilestones").Select
    Range("A1").Select
    ActiveSheet.Paste

    ActiveSheet.ListObjects(1).Unlist


    Dim LastRow As Long
    Dim pasteRowIndex As Long



    With Sheets("NoMilestones")


     Dim SOW As String

 Dim SowRow As Long

 SowRow = 1

    .Columns(3).Insert Shift:=xlToRight
    .Columns(4).Insert Shift:=xlToRight
    .Cells(1, "C").Value = "SOW contains Milestones"
    .Cells(1, "D").Value = "Record has Milestone"


 Application.ActiveSheet.UsedRange
    LastRow = Worksheets("NoMilestones").UsedRange.Rows.Count



    For r = 1 To LastRow


        If LCase(.Cells(r, "N").Value) Like LCase("Milestone*") Then
       .Cells(r, "D").Value = "Has Milestones"


       SOW = .Cells(r, "B").Value
       ActiveWorkbook.Worksheets("SOWMilestoneList").Cells(SowRow, "A").Value = SOW
       ActiveWorkbook.Worksheets("SOWMilestoneList").Cells(SowRow, "B").Value = "True"

       SowRow = SowRow + 1




   End If

       Next r

       Range("C2").Select

        ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],SOWMilestoneList!C[-2]:C[-1],2,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C18990")
    Range("C2:C18990").Select

      Columns("C:C").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



    End With


    Dim PSheet As Worksheet
    Dim DSheet As Worksheet
    Dim PCache As PivotCache
    Dim PTable As PivotTable
    Dim PRange As Range
    Dim LastRow1 As Long
    Dim LastCol As Long


    'Insert a New Blank Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("NoMilestonesPT").Delete
    Sheets.Add Before:=ActiveSheet
    ActiveSheet.Name = "NoMilestonesPT"
    Application.DisplayAlerts = True
    Set PSheet = Worksheets("NoMilestonesPT")
    Set DSheet = Worksheets("NoMilestones")
    On Error Resume Next

    'Define Data Range
    LastRow1 = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    Set PRange = DSheet.Cells(1, 1).Resize(LastRow1, LastCol)


'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="NoMilestonesPivotTable")


    'Insert Blank Pivot Table
    Set PTable = PCache.CreatePivotTable _
    (TableDestination:=PSheet.Cells(1, 1), TableName:="NoMilestonesPivotTable")



End Sub