Looping a code through different and specific worksheets

user_15971531 0
Viewed 32

I am fairly new to VBA and I am trying to get better. I have a workbook that I am trying to loop a code through. but only on specific worksheets - not the whole book. Basically, I wrote a code that will reformat a pivot table as a table, and format the headers etc. This works perfectly in one sheet. But I have 10 more sheets this needs to be done with - for my colleagues (who is not excel wizards, it would be better if this could be done with the touch of a button - so to say).

I have googled for hours and tried many different stuff, sometimes I don't get an error but the code isn't applied to the other worksheets when running as macro.

(B11 is a static starting point for all sheets)

This is the code:

     Sub Ultimo_Pivot_Table()

'Start Loop? 
        
        'Select and copy pivot
            Columns("B:O").Select
            Selection.Copy
            Columns("P:P").Select
        'Paste pivot in new area
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        'Delete old pivot
            Columns("B:O").Select
            Range("O1").Activate
            Application.CutCopyMode = False
            Selection.Delete Shift:=xlToLeft
        'Select & Format as table
        With Range("B11")
            .Parent.ListObjects.Add(xlSrcRange, Range(.End(xlDown), .End(xlToRight)), , xlYes).Name = "Table1"
        End With
        'Format Headlines
        With Range("B11")
            Range(Selection, Selection.End(xlToRight)).Select
        End With
            With Selection
                .HorizontalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With Selection.Font
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = -0.499984740745262
            End With
            Range("B2").Select
            With Selection
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
'End Loop? 

        End Sub

I have tried so many different things so this is the raw code without any attempts at looping. Any suggestions? Thank you!

vba excel
2 Answers

Untested but you should get the idea:

Sub Tester()

    Dim ws As Worksheet
    'loop over the sheets in the workbook containing this code
    For Each ws In ThisWorkbook.Worksheets
        'call the sub and pass the sheet if there's a pivottable
        If ws.PivotTables.Count = 1 Then Ultimo_Pivot_Table ws
    Next ws

End Sub

Sub Ultimo_Pivot_Table(ws As Worksheet)

    Dim lo As ListObject
        
    ws.Columns("B:O").Copy
    With ws.Range("P1")
        .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        .PasteSpecial Paste:=xlPasteValues
    End With
    ws.Columns("B:O").Delete Shift:=xlToLeft
    
    Set lo = ws.ListObjects.Add(xlSrcRange, ws.Range("B11").CurrentRegion, , xlYes)
    lo.Name = "Table1"
    
    With lo.HeaderRowRange
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.ThemeColor = xlThemeColorLight1
        .Font.TintAndShade = -0.499984740745262
    End With
    
    With ws.Range("B2")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
    End With

End Sub
user_4788840

The following is an example of how to loop through worksheets. You can call your macro in each iteration:

Sub example()

    Dim i, n
    n = Worksheets.Count
    For i = 1 To n
        Worksheets(i).Activate
    Next i
    
End Sub
user_31003120
Related