Exécuter macro sur toutes les feuilles

Le 24/09/2018 à 12:31

Bonjour,

J'ai réalisé une macro; mais je souhaiterais qu'elle se réalise sur toutes les feuilles du classeur et pas être obligé de la faire s'exécuter feuille par feuille !

En effet gain de temps car je peux avoir jusqu'à 150 feuille dans un classeur.

je mets en PJ un fichier modèle simplifier (macro et nombre de feuilles)

https://www.cjoint.com/c/HIykBYa0foJ

MERCI

@+++

Le 24/09/2018 à 12:56

Bonjour

Vous fusionnez plein de colonnes inutilement dans ce fichier. Pourquoi ? A éviter lorsque vous faites appel à VBA

Je modifie votre fichier avec le code adapté ?

Cordialement

Le 24/09/2018 à 13:34

Bonjour malpas.

Voilà ce que tu souhaites, il suffit d'appeler la procédure "BoucleSh" pour que toutes tes feuilles du classeur soient mise en forme.

En revanche tu as besoin de revoir ta procédure "miseenpage", car si tu applique ça sur 150 feuilles tu vas trouver le temps long.

Les pistes pour l'améliorer : s'affranchir des "Select", de "l'activate" que j'ai placé, désactiver le "ScreenUpdating"

Sub BoucleSh()

Dim Sh As Worksheet

For Each Sh In Worksheets
  miseenpage Sh
Next Sh

End Sub

Sub miseenpage(Sh As Worksheet)
'
' miseenpage Macro
'

'

    Sh.Activate

    Range("B2:T2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("E7:F7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("E8:F8").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("G7:H7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("G8:H8").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("I7:J7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("I8:J8").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("L4:N6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("O4:P4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Copy
    Range("O5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("O6").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    Range("Q4").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("Q5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("Q6").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("Q8:R8").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("S8:T8").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("S6").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("S5").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("S4").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("I4:J4").Select
    Selection.Font.Bold = True
    Selection.Font.Size = 16
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
End Sub
Le 25/09/2018 à 05:53
Dan a écrit :

Bonjour

Vous fusionnez plein de colonnes inutilement dans ce fichier. Pourquoi ? A éviter lorsque vous faites appel à VBA

Je modifie votre fichier avec le code adapté ?

Cordialement

Bonjour,

Oui je veux bien volontiers !

MERCI

Le 25/09/2018 à 12:18

Bonjour,

Voici les modifications sur la procédure "MiseEnPage"

Option Explicit

Sub BoucleSh()

  Dim Sh As Worksheet

  Application.ScreenUpdating = False

  For Each Sh In Worksheets
    MiseEnPage Sh
  Next Sh

  Application.ScreenUpdating = True

End Sub

Sub MiseEnPage(Sh As Worksheet)

  With Sh

    With .Range("B2:T2,E7:F7,E8:F8,G7:H7,G8:H8,I7:J7,I8:J8,L4:N4,L5:N5,L6:N6,O4:P4,O5:P5,O6:P6,Q4:R4,Q5:R5,Q6:R6,Q8:R8,S4:T4,S5:T5,S6:T6,S8:T8")
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .WrapText = False
      .Orientation = 0
      .AddIndent = False
      .IndentLevel = 0
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = True
    End With

    With .Range("I4:J4").Font
      .Bold = True
      .Size = 16
      .Color = -16776961
      .TintAndShade = 0
    End With

  End With

End Sub
Le 25/09/2018 à 13:13

Re

Vois le fichier en pièce jointe avec le code modifié et adapté pour la mise en page de toutes les feuilles

Les feuilles doivent toutes être formatées comme la feuille A (j'ai refait les feuilles B à E, elles sont donc identiques à la feuille A)

Il n'y a plus de cellules fusionnées dans les feuilles hormis sur la ligne 2

Si ok, merci de cloturer le fil lors de votre réponse en cliquant sur le petit v en haut à droite

Cordialement

25test.zip (14.56 Ko)
Rechercher des sujets similaires à "executer macro toutes feuilles"