Macro à boucler et décaler avec un pas

[Anthonymctm]

Bonjour le Forum,

J'ai besoin de votre aide sur une macro bricolée à l'enregistreur de macro et qui doit se dupliquer dans des lignes plus bas avec un pas bien définit.

En fait la macro s'utilise sur un onglet de récap. Cet onglet récapitule un ou plusieurs onglets. Les onglets porteront toujours le titre suivant "EC (x)".
Initialement dans le fichier il n'y a qu'un onglet EC (1) si besoin on peut le dupliquer et ainsi il se nomme EC (2).

Il peut y avoir de 1 EC jusqu'à 15. Pour éviter que la macro ne s'applique sur les 15 (elle est déjà longue sur 1 ^^'), j'aimerais tester le nombre d'onglets commençant par "EC (" et appliquer une loop autant de fois qu'il y a d'onglet en augmentant les n° de ligne dans la macro d'un certains pas.

La macro (si vous voyez comment l'optimiser au passage) :

Sub MEFdescriptif()
Application.ScreenUpdating = False
Range("X12:AE12").Select
    Selection.Copy
    Range("C12:J47").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
    .Font.Bold = False
    .Copy
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .HorizontalAlignment = xlJustify
   End With
   Range("AF3").Select
   Selection.Copy
    Range("A3:C3").Select
    ActiveSheet.Paste
    Chercher_Colorier_plage_liste Range("A3:L52"), Range("O12:O52")
Application.ScreenUpdating = True
End Sub

Ca c'est valable pour le EC (1), s'il y a un EC (2), il faudrait que la macro recommence en décalant les lignes de +49 (à part le premier range) ce qui donnerait :

Sub MEFdescriptif()
Application.ScreenUpdating = False
Range("X12:AE12").Select
    Selection.Copy
    Range("C61:J96").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
    .Font.Bold = False
    .Copy
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .HorizontalAlignment = xlJustify
   End With
   Range("AF52").Select
   Selection.Copy
    Range("A52:C52").Select
    ActiveSheet.Paste
    Chercher_Colorier_plage_liste Range("A52:L101"), Range("O61:O101")
Application.ScreenUpdating = True
End Sub

Voilà, qu'en pensez-vous ?
Ca devrait pouvoir se faire je pense

Merci à tous !

 

[Anthonymctm]

Super ! 😀

Merci bien ! Je mets ça sur mon fichier d'origine et si tout est bon je mets en résolu ! 🙂

 

[Anthonymctm]

Sur mon fichier d'origine j'avais une erreur "incompatibilité de type"..
Que je n'ai pas avec strictement le même code sur mon fichier test..
Ca venait d'une formule que je souhaitais copié qui avait des bug de #ref.

On en apprend tous les jours, encore merci ! 😉