Exécuter macro sur toutes les feuilles
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
@+++
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 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
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
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