2 votes

Boucle d'un code à travers des feuilles de calcul différentes et spécifiques

Je suis assez novice en VBA et j'essaie de m'améliorer. J'ai un classeur dans lequel j'essaie de faire passer un code en boucle, mais uniquement sur des feuilles de calcul spécifiques - pas sur l'ensemble du classeur. En fait, j'ai écrit un code qui reformatera un tableau croisé dynamique en tableau, et qui formatera les en-têtes, etc. Cela fonctionne parfaitement sur une feuille. Mais j'ai 10 autres feuilles sur lesquelles cela doit être fait - pour mes collègues (qui ne sont pas des magiciens d'Excel, ce serait mieux si cela pouvait être fait en appuyant sur un bouton - pour ainsi dire).

J'ai cherché pendant des heures et essayé beaucoup de choses différentes, parfois je n'obtiens pas d'erreur mais le code n'est pas appliqué aux autres feuilles de calcul lorsqu'il est exécuté en tant que macro.

(B11 est un point de départ statique pour toutes les feuilles)

Voici le 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

J'ai essayé tellement de choses différentes que voici le code brut sans aucune tentative de bouclage. Des suggestions ? Je vous remercie de votre attention.

1voto

Tim Williams Points 31438

Non testé, mais vous devriez vous faire une idée :

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

0voto

Paul Ogilvie Points 4852

Voici un exemple de la manière dont on peut parcourir les feuilles de calcul en boucle. Vous pouvez appeler votre macro à chaque itération :

Sub example()

    Dim i, n
    n = Worksheets.Count
    For i = 1 To n
        Worksheets(i).Activate
    Next i

End Sub

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X