Discussion :

[Anthony47]

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) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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 !

[EricDgn]

Bonjour,

Vos macros n'indiquent pas clairement la feuille qui est 'copiée' et la feuille qui est 'collée', et c'est comme si vous vouliez copier 1 ligne et la coller 36 fois. Mais voici toujours une macro pour simplement parcourir toutes les feuilles du dossier et y calculer la plage (présumée de destination) en fonction de la valeur qui se trouve entre () dans le nom de la feuille (présumée à copier).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Sub Loop_CE()
   Dim wshCE As Worksheet, k As Integer, k1 As Long, k2 As Long, sRng As String
   For Each wshCE In ThisWorkbook.Worksheets
      If InStr(wshCE.Name, "CE (") = 1 Then
         k = Val(Mid(wshCE.Name, 5))         '--- valeur qui se trouve entre ()
         k1 = 12 + (k - 1) * 49
         k2 = k1 + 35
         sRng = "X" & k1 & ":J" & k2
         Debug.Print k, k1, k2, sRng
      End If
   Next wshCE
End Sub

Bonne continuation

[Anthony47]

Bonjour Eric,

Merci de ton aide,

La macro s’exécute sur un seul onglet et les données a récupérer sont sur ce même onglet; je pense que c'est pour ça que ce n'est pas spécifié.
Le titre de l'onglet en question est "descriptif"

En fait sur ce même onglet j'ai un format de page à imprimer qui s'entend vers le bas, (une page imprimée = un onglet EC (x) créé. Mais ça c'est déjà géré). Et pour l'instant je suis parvenu a faire cette macro qui ne s'applique qu'à la première page et il faut que je puis la looper pour qu'elle le fasse sur autant de page qu'il y a d'onglets EC (x) et décalant l'application de la macro a chaque fois.

J'espère que c'est plus clair

[Qwazerty]

SAlut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Sub MEFdescriptif()
    Application.ScreenUpdating = False
    Feuil1.Range("X12:AE12").Copy
    Feuil2.Range("C12:J47").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
        'Pas sûr ici, si je suis ton code ça serait de la feuil2 vers la feuil2 ?
    Feuil1.Range("AF3").Copy Feuil2.Range("A3:C3")
    '?'Chercher_Colorier_plage_liste Range("A3:L52"), Range("O12:O52")
    Application.ScreenUpdating = True
End Sub

Mais bon, c'est juste une mise en forme du code, il nous faudrait au moins une copie d'écran pour être sur de bien comprendre la structure de tes feuilles.

++
Qwaz

[Anthony47]

Salut qwazerty,

Alors oui ca va bien de la feuille2 ou "descriptif" à descriptif.

En fait la macro en question me sert à copier une formule et la coller sous un format texte pour ensuite pouvoir appliquer la formule chercher colorier qui modifier seulement quelque caractère des cellule (chose impossible dans une formule).

Et donc il faudrait "juste" remplacer les ligne par des variables et les augmenter d'un certains facteur à chaque fois.

[Qwazerty]

Salut

Sans plus d'info, voilà un exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
 
Sub MEFdescriptif()
Dim iLigne As Integer
 
 
    Application.ScreenUpdating = False
 
    'Vu que tu ne donne pas plus de détail à toi de paramètrer  la boucle suivante
    '203 correspond à la butté et 50 au pas, donc ici ligne vaudra 3 puis 53 puis 103 puis 153 puis 203
    For iLigne = 3 To 203 Step 50
        With Feuil1
            .Range(.Cells(iLigne + 9, "X"), .Cells(iLigne + 9, "AE")).Copy
        End With
        With Feuil2
            .Range(.Cells(iLigne + 9, "C"), .Cells(iLigne + 44, "J")).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
            'Pas sûr ici, si je suis ton code ça serait de la feuil2 vers la feuil2 ?
            'Un autre façon de faire une selection étendue avec la fonction resize
        Feuil1.Cells(iLigne, "AF").Copy Feuil2.Cells(iLigne, "A3").Resize(1, 3)
        '?'Chercher_Colorier_plage_liste Range("A3:L52"), Range("O12:O52")
    Next
    Application.ScreenUpdating = True
End Sub

++
Qwaz