Macro à boucler et décaler avec un pas

Anthonymctm · 12 Décembre 2019

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 !

Anthonymctm · 18 Décembre 2019

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 · 16 Décembre 2019

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 · 16 Décembre 2019

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 · 16 Décembre 2019

Salut xUpsilon, merci de ton aide et de tes conseils

xUpsilon à dit:
- 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.

xUpsilon à dit:
- 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.

xUpsilon à dit:
- 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

xUpsilon à dit:
- 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.

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

xUpsilon · 16 Décembre 2019

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 · 16 Décembre 2019

xUpsilon à dit:
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 )

xUpsilon · 16 Décembre 2019

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

Anthonymctm · 18 Décembre 2019

Bon, pour les compter j'ai aussi réussi à mettre une formule en A2 dans l'onglet "recap param".

Ca ok, maintenant pour remplacer tous mes numéros de lignes par une variable.. Je ne sais pas comment faire

xUpsilon · 18 Décembre 2019

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 · 18 Décembre 2019

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 · 18 Décembre 2019

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 · 18 Décembre 2019

Ah oui d'accord, je test tout ça et je reviens vers toi !

Merci !

Anthonymctm · 18 Décembre 2019

Alors visiblement la syntaxe de Range("C"&i+11&":c"&i+46) est pas bonne au niveau du :
je tente avec Range("C" & i + 11, "c" & i + 46)

Anthonymctm · 18 Décembre 2019

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

xUpsilon · 18 Décembre 2019

Re,

Déjà j'ai oublié de te préciser : il faut initialiser NbFeuil à 0 sinon tu pourrais avoir des soucis.
Ensuite, qu'est ce qui s'exécute 3 fois, la deuxième boucle ? Enlève le +1 dans NbFeuil * 49 + 1 et ça devrait le faire.

Bonne continuation

Macro à boucler et décaler avec un pas

Anthonymctm

XLDnaute Occasionnel

Anthonymctm

Anthonymctm

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Anthonymctm

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Anthonymctm

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Anthonymctm

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Anthonymctm

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Anthonymctm

XLDnaute Occasionnel

Anthonymctm

XLDnaute Occasionnel

Anthonymctm

XLDnaute Occasionnel

xUpsilon

XLDnaute Accro

Discussions similaires