Create Pivot Table Macro

[Jones1413]

Hello,

I have a worksheet of data that I want to create a Pivot Table out of. The number of rows and columns of data change weekly. I have the below macro but when I run the macro, nothing populates on the newly created worksheet. I'm not sure what I am missing and why the pivot table is not being created.

Sub Pivot_Table()

'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long

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

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

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

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

With ActiveSheet.PivotTables("TeamReq").PivotFields("Current Status")
.Orientation = xlPageField
.Position = 1
End With

With ActiveSheet.PivotTables("TeamReq").PivotFields("Recruiter Name")
.Orientation = xlRowField
.Position = 1
    End With

End Sub