Macro à boucler et décaler avec un pas

Anthonymctm

XLDnaute Occasionnel
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) :
VB:
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 :

VB:
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 !
 
Dernière édition:
Solution
J'ai fait ça
VB:
Sub MEF_descriptif()
   Dim i, NbFeuil As Integer
'Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
    If Worksheets(i).Name Like "EC*" Then NbFeuil = NbFeuil + 1
Next i
For i = 1 To NbFeuil * 49 + 1 Step 49
Range("X12:AE12").Copy
    Range("C" & i + 11, "c" & i + 46).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("AF" & i + 2).Copy
    Range("A" & i + 2, "C" & i + 2).Select
    ActiveSheet.Paste...

Anthonymctm

XLDnaute Occasionnel
Histoire de vous apporter plus d'éléments :

-La macro ne se déroule que sur un seul onglet
-Le "pas" est fixe et valable pour toute la macro (actuellement = 49)
-Il faudrait qu'on exécute chaque loop selon le nombre d'onglets commençant par "EC ("

Si j'ecris manuellement ce qui devrait se passer :
VB:
Sub MEFdescriptif()
Application.ScreenUpdating = False

    '1er tour de la loop
    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")
   

    '2eme tour de la loop parcequ'il y a un onglet EC (2) ,donc 2 onglets commençant par EC (
   Range("X12:AE12").Select 'que celui-ci qui ne change pas
    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")
   
    '3eme tour de la loop parcequ'il y a un onglet EC (3) ,donc 3 onglets commençant par EC (
   Range("X12:AE12").Select 'que celui-ci qui ne change pas
    Selection.Copy
   
      Range("C110:J145").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("AF101").Select
   Selection.Copy
    Range("A101:C101").Select
    ActiveSheet.Paste
    Chercher_Colorier_plage_liste Range("A101:L150"), Range("O110:O150")
   
   
Application.ScreenUpdating = True
End Sub
 

xUpsilon

XLDnaute Accro
Bonjour,

Bon plusieurs points et tu me dis ce qu'il te manque encore/ce qui ne va pas :
- faire une macro qui loop que sur les onglets "EC*" : il existe une propriété appelée Worksheets.Count qui te retourne le nombre d'onglets de ta feuille. Ainsi, tu peux créer une petite boucle préliminaire qui boucle sur toutes tes feuilles et note (dans un array par exemple) les noms des feuilles commençant par "EC". Comme ça tu ne boucles par sur toutes, mais seulement sur celles sorties en "préliminaire".
- tu abuses des .Select. Pour pouvoir copy et paste tu n'as pas besoin de sélectionner, la méthode Range.Copy et Range.PasteSpecial est suffisante pour faire ce que tu veux faire ici.
- copier une place d'une certaine taille sur une autre plage de la même taille, ça fonctionne en collant la zone copiée uniquement sur la cellule en haut à gauche de la zone où tu colles. Ca t'évite d'avoir à sélectionner une grande zone, alors que tu n'aurais besoin que de Range la cellule en haut à gauche.
- quand tu copies/colles, tu formates ensuite tes cellules (With Selection ____) mais si ce format est déjà ainsi dans les cellules depuis lesquelles tu copies/colles, tu peux utiliser xlPasteAll plutôt que xlPasteFormulas uniquement. Ou tu peux également avoir deux lignes de Paste qui vont être xlPasteFormulas et xlPasteFormat (tu les mets à la suite, ça fonctionne très bien).

Voilà les premières choses que j'ai remarqué/qui pourraient t'aider. Dis moi ce que tu en penses, si ça répond à ton problème et si non, fais moi un retour.

Bonne continuation
 

Anthonymctm

XLDnaute Occasionnel
Salut xUpsilon, merci de ton aide et de tes conseils

- faire une macro qui loop que sur les onglets "EC*" : il existe une propriété appelée Worksheets.Count qui te retourne le nombre d'onglets de ta feuille. Ainsi, tu peux créer une petite boucle préliminaire qui boucle sur toutes tes feuilles et note (dans un array par exemple) les noms des feuilles commençant par "EC". Comme ça tu ne boucles par sur toutes, mais seulement sur celles sorties en "préliminaire".
Ma macro ne s'applique que sur l'onglet "Descriptif", elle ne doit pas s'appliquer sur les onglets EC*. Par contre on se sert du nombre d'onglets EC* pour savoir combien de fois "looper" la macro.

- tu abuses des .Select. Pour pouvoir copy et paste tu n'as pas besoin de sélectionner, la méthode Range.Copy et Range.PasteSpecial est suffisante pour faire ce que tu veux faire ici.
Ok, merci, c'était issu de l'enregistreur de macro ^^'
Alors c'est bon sauf pour le dernier
Range("AF3").Copy
Range("A3:C3").Select
ActiveSheet.Paste
Si je le remplace par
Range("AF3").Copy
Range("A3:C3").Paste (idem si range ("AC3").paste )
J'obtiens une erreur 438 propriété ou méthode non gérée par cet objet.

- copier une place d'une certaine taille sur une autre plage de la même taille, ça fonctionne en collant la zone copiée uniquement sur la cellule en haut à gauche de la zone où tu colles. Ca t'évite d'avoir à sélectionner une grande zone, alors que tu n'aurais besoin que de Range la cellule en haut à gauche.
Je viens de le faire, aucun soucis par rapport à ca, ça raccourcis un peu le code c'est cool, merci :)

- quand tu copies/colles, tu formates ensuite tes cellules (With Selection ____) mais si ce format est déjà ainsi dans les cellules depuis lesquelles tu copies/colles, tu peux utiliser xlPasteAll plutôt que xlPasteFormulas uniquement. Ou tu peux également avoir deux lignes de Paste qui vont être xlPasteFormulas et xlPasteFormat (tu les mets à la suite, ça fonctionne très bien)

J'avais utilisé ça parce que je copie une celulle et je colle dans une cellule fusionné, et ça c'est pas possible manuellement : message d'erreur. Comme j'ai fait la macro avec l'enreugistreur de macro j'ai du faire ça en deux étapes. Par contre la celule initial n'a pas le bon format, je dois donc quand meme le réinitialiser, c'est pour ça que je fait un .Font.Bold = False d'abord. Après je sais pas s'il y a quand même plus efficace à faire. :rolleyes:

En résumé, ton retour améliore bien mon code (et ma compréhension du VBA ^^) mais ne répond pas encore à la problématique de la loop à créer.

Merci déjà pour ta réponse en tout cas :D
 

xUpsilon

XLDnaute Accro
Re,

- Pour le Loop il te suffit dès lors de créer une variable NbFeuil qui s'exécute comme ceci : boucler sur toutes les feuilles, si feuille.nom like "EC*" alors incrémenter.
Comme ça tu récupères combien de feuilles commencent par EC à la fin et tu peux looper autant de fois.

- Range.Paste n'existe pas, il faut utiliser .PasteSpecial

- Je n'avais pas compris qu'il y avait des cellules fusionnées, effectivement c'est une plaie à manier ... Sinon tu peux commencer par défusionner, appliquer, puis refusionner, mais je pense que ça va ralentir ta macro donc pas sûr que tu y gagnes grand chose.

Bonne continuation
 

Anthonymctm

XLDnaute Occasionnel
Re,

- Pour le Loop il te suffit dès lors de créer une variable NbFeuil qui s'exécute comme ceci : boucler sur toutes les feuilles, si feuille.nom like "EC*" alors incrémenter.
Comme ça tu récupères combien de feuilles commencent par EC à la fin et tu peux looper autant de fois.

C'est bien la le problème ^^'
Je ne sais pas comment faire pour "looper" tout ça, incrémenter mes n° de lignes ni compter le nombre de feuilles EC (je vois l'idée, mais le code c'est une autre affaire :confused:)
 

xUpsilon

XLDnaute Accro
Re,

Pour compter le nombre de feuilles dont le nom commence par "EC" :
VB:
Dim i, NbFeuil as integer

For i = 1 to Worksheets.Count
    If Worksheets(i).Name like "EC*" then NbFeuil = NbFeuil + 1
Next i
MsgBox NbFeuil

Pour incrémenter il y aurait plusieurs possibilités : une boucle For qui incrémente de 49 en 49 (après For x = _ to __ tu peux indiquer le pas), une boucle While dans laquelle tu incrémentes ta var de 49 en 49 ou encore une variable Statique que tu incrémentes de 49 à chaque tour.

Bonne continuation
 

xUpsilon

XLDnaute Accro
Re,

Eh bien je t'ai proposé plusieurs choses plus haut, mais prenons un exemple avec un for :
VB:
For i = 1 to NbFeuil

blablabla
Range("A" & i*49-48) = blablabla
blablabla

Next i

Ici i est une variable d'incrémentation classique qui va aller de ta première feuille à la nième feuille. En insérant i*49, tu vas sauter 49 lignes à chaque fois. Le -48 est présent simplement parce que 0*49 = 0 et si on dit à Excel d'aller écrire en A0 il va faire la gueule.

Sinon on pourrait aussi avoir qqchose du genre
Code:
For i = 1 to NbFeuil*49+1 Step 49

blablabla

Next i
Grâce à la définition du "Step", tu incrémentes ton i de 49 en 49.

Bref dis moi ce que tu en penses.

Bonne continuation
 

Anthonymctm

XLDnaute Occasionnel
Dans ton deuxième exemple je modifie mon range par
VB:
Range("A" & i-48) = blablabla
?

Dans mon exemple j'ai initialement
Code:
Range("C12:c47").PasteSpecial

Je dois remplacer ça par
Code:
For i = 1 to NbFeuil*49+1 Step 49

Range("C"&i+12&":c"&i+47).PasteSpecial

Next i
?
 

xUpsilon

XLDnaute Accro
J'ai juste écrit mon truc comme exemple, expliques moi où est-ce que tu veux écrire. Quoi qu'il en soit ce n'est pas ça, ici tu pourrais avoir un Range("A[-47]"), sauf que je ne crois pas que les lignes négatives existent ;)

Plutôt ceci je pense non ?
VB:
For i = 1 to NbFeuil*49+1 Step 49

Range("C"&i+11&":c"&i+46).PasteSpecial

Next i
i commence à 1, pas à 0. Après fais des essais et adapte, c'est difficile de te dire comme ça

Bonne continuation
 

Anthonymctm

XLDnaute Occasionnel
J'ai fait ça
VB:
Sub MEF_descriptif()
   Dim i, NbFeuil As Integer
'Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
    If Worksheets(i).Name Like "EC*" Then NbFeuil = NbFeuil + 1
Next i
For i = 1 To NbFeuil * 49 + 1 Step 49
Range("X12:AE12").Copy
    Range("C" & i + 11, "c" & i + 46).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("AF" & i + 2).Copy
    Range("A" & i + 2, "C" & i + 2).Select
    ActiveSheet.Paste
    Chercher_Colorier_plage_liste Range("A" & i + 2, "C" & i + 48), Range("O" & i + 11, "O" & i + 48)
'Application.ScreenUpdating = True
Next
End Sub

Ca l'aire de plutot pas mal fonctionner mais ça loop une fois de trop.
J'ai mis deux onglet EC, le msg box indique bien 2, mais ça s'éxécute 3 fois
 

Discussions similaires

Réponses
2
Affichages
80

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof