Option Explicit
Sub createPivotTableExistingSheet()
Dim rMainData As Range
Dim wsPT As Worksheet, wsItem As Worksheet
Dim myPivotTable As PivotTable
Dim ptItem As PivotItem
Set rMainData = MainData.Cells(1, 1).CurrentRegion ' Note - Using code name for WS "Main Data"
Set wsPT = AddSheet("PT")
Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=rMainData).CreatePivotTable(TableDestination:=wsPT.Cells(1, 1), TableName:="PivotTableExistingSheet")
With myPivotTable
.PivotFields("Item").Orientation = xlPageField
.PivotFields("OrderDate").Orientation = xlRowField
.PivotFields("Region").Orientation = xlRowField
.PivotFields("Rep").Orientation = xlRowField
.PivotFields("Units").Orientation = xlRowField
.PivotFields("Unit Cost").Orientation = xlRowField
With .PivotFields("Total")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0.00"
End With
.RowAxisLayout xlTabularRow
.PivotFields("OrderDate").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Region").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Rep").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Item").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Units").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Unit Cost").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.PivotFields("Total").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
.ColumnGrand = False
.RowGrand = False
.PivotFields("OrderDate").AutoSort xlAscending, "OrderDate"
.PivotFields("Region").AutoSort xlAscending, "Region"
.PivotFields("Rep").AutoSort xlAscending, "Rep"
For Each ptItem In .PivotFields("Item").PivotItems
.PivotFields("Item").ClearAllFilters
.PivotFields("Item").CurrentPage = ptItem.Value
Set wsItem = AddSheet(ptItem.Value)
.TableRange1.Copy
wsItem.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsItem.Cells(1, 1).CurrentRegion.Font.Bold = False
wsItem.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
Next
End With
End Sub
Private Function AddSheet(S As String) As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(S).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Call ThisWorkbook.Worksheets.Add(MainData)
ActiveSheet.Name = S
Set AddSheet = ActiveSheet
End Function