RE: Pivot table creation in existing sheet- VBA issues

[Paul_Hossler]

Here's something to consider -- my guess as to where you wanted to get to

Some of that code was way more complicated than needed

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