Hi all, apologies if this has been asked elsewhere and I missed it.

I'm trying to write a macro to automate the production of reports from a single source file, all of which then need to be sent to individuals for expense-claiming purposes.

I've successfully automated the process to the point of generating a pivot table which is then split to multiple tabs. However, I'm stuck with progressing things further. I have written a script that successfully removes the pivot from each tab, leaving only the raw data formatted into tables. However, the script only works on one tab at a time when I manually run it; when I try to make it loop through all tabs on the active workbook, Excel crashes horribly. There will typically be around roughly 100 tabs. I haven't even started on the part of the script that exports each tab to separate files!

Is there a better way of doing this, or is my code just horribly optimised?


        Sub AAInvoiceSplit()
        
        Application.ScreenUpdating = False
        
        ' ICPIA Tidyup
        
        Dim DSheet As Worksheet
        Set DSheet = ActiveSheet
        
            Range("W1:AR1").Cut
            Rows("2:2").Insert shift:=xlDown
            Columns("P:P").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Columns("O:O").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("O1").FormulaR1C1 = "Duration (Mins)"
            Range("Q1").FormulaR1C1 = "Data Usage (Gb)"
            Range("O2").FormulaR1C1 = "=RC[-1]/60"
            Range("Q2").FormulaR1C1 = ""
            
            LastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
            Range("O2:O" & LastRow1).Formula = "=N2/60"
            Range("Q2:Q" & LastRow1).Formula = "=P2/1024/1024"
            Range("A1:U" & LastRow1).Copy
            Range("A1:U" & LastRow1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
        
            Range("U:V,S:S").Delete shift:=xlToLeft
            
            
        ' Split charges to one mobile number per tab
        
        '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
        Worksheets("PivotTable").Delete
        Sheets.Add Before:=ActiveSheet
        ActiveSheet.Name = "PivotTable"
        Application.DisplayAlerts = True
        Set PSheet = Worksheets("PivotTable")
        'Set DSheet = Worksheets("Data")
        
        '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:="Pivot")
        
        'Insert Blank Pivot Table
        Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:="Pivot")
        
        'Insert Row Fields
        
            With ActiveSheet.PivotTables("Pivot").PivotFields("Carrier Description" & Chr(13) & "")
                .Orientation = xlRowField
                .Position = 1
            End With
        
        'Insert Columns and split to tabs
        
            With ActiveSheet.PivotTables("Pivot").PivotFields("Mobile #")
                .Orientation = xlPageField
                .Position = 1
            End With
        
            
            ActiveSheet.PivotTables("Pivot").AddDataField ActiveSheet.PivotTables( _
                "Pivot").PivotFields("Ex Tax Amount"), "Sum of Ex Tax Amount", xlSum
            With ActiveSheet.PivotTables("Pivot").PivotFields("Sum of Ex Tax Amount")
                .NumberFormat = "$#,##0.00"
            End With
        
      
        
            ActiveSheet.PivotTables("Pivot").PivotFields("Carrier Description" & Chr(13) & ""). _
                AutoSort xlDescending, "Sum of Ex Tax Amount", ActiveSheet.PivotTables( _
                "Pivot").PivotColumnAxis.PivotLines(1), 1
            ActiveSheet.PivotTables("Pivot").RowGrand = False
            ActiveSheet.PivotTables("Pivot").ShowPages PageField:="Mobile #"
        
        ' Remove Pivot formatting from all tabs
        
        Dim xsheet As Worksheet
        For Each xsheet In ThisWorkbook.Worksheets
        xsheet.Select
        RemovePivots
         Next xsheet
        
        
        
    End Sub
    
        
    Sub RemovePivots()
        
        
        
        Range("A3:B90").Copy
        Range("A101").Select
        
        With Selection
        .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
        End With
    
        Range("A1:B1").Copy
        Range("A99").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Rows("1:98").Delete shift:=xlUp
        
        Columns("A").Replace _
     What:="Row Labels", Replacement:="Category", _
     SearchOrder:=xlByColumns, MatchCase:=True
        
    Dim LastRow3 As Integer
    LastRow3 = Range("A" & Rows.Count).End(xlUp).Row
    ActiveSheet.Rows(LastRow3 & ":" & LastRow3).Delete shift:=xlUp
    
    Dim LastRow4 As Integer
    LastRow4 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A3:B" & LastRow4), , xlYes).Name = _
            "Table1"
    ActiveSheet.ListObjects("Table1").ShowTotals = True
    
        
        End Sub