Dupliquer des lignes (macro)

Question

J'aurai besoin de faire une macro pour dupliquer certaines lignes de mon document excel. Dans le fichier joint "test_1", je désire dupliquer: la ligne 7 et 12 --&gt; 2 fois (car nombre de cas = 2) ; la ligne 9 --&gt; 3 fois (car nombre de cas = 3) ; la ligne 4 --&gt; 6 fois. Merci d'avance pour votre aide, Elias...

MFerrand · Answer

&#91;désolé : enlevé macro car une erreur, mais mon infirmière étant là je ne puis revoir dans l'immédiat...&#93; Cordialement Ferrand...

ThauThème · Answer

Commence par faire sur une copie de ton fichier puis essaie ce code : Sub Macro1() Dim O As Worksheet 'déclare la variable O (onglet) Dim TC As Variant 'déclare la variable TC (Tableau de Cellules) Dim NL As Integer 'déclare la variable NL (Nombre de Lignes) Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes) Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes) Dim I As Integer 'déclare la variable I (Incrément) Dim J As Integer 'déclare la variable J (incrément) Dim K As Integer 'déclare la variable K (incrément) Dim NdC As Byte 'déclare la variable NdC (Nombre de Cas) Set O = Sheets("Feuil1") 'définit l'onglet O TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellules TC NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellules TC K = 1 'initialise la variable K For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellules TC (en partant de la seconde) For NdC = 1 To TC(I, 1) 'boucle 2 : sur le nombre de cas (indiqué dans la valeur ligne I colonne 1 de TC) ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonnes, K colonnes) For J = 1 To NC 'boucle 3 : sur toutes les colonnes de TC TL(J, K) = TC(I, J) 'récupère dans la ligne J de TL la valeur de la colonne J de TCransposition) Next J 'prochaine colonne de la boucle 3 K = K + 1 'incrémente K (ajoute une colonne à TL) Next NdC 'prochain cas de la boucle 2 Next I 'prochaine ligne de la boucle 3 'si K est supérieur à 1 (précaution inutile dans ton cas) renvoie dans A2 (à adapter) redimensionnée le tableau TL transposé If K &gt; 1 Then O.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) End Sub Comme tu n'as pas précisé où se faisait la duplication je l'ai directement faite dans le tableau d'origine. C'est pour cela que je t'ai conseillé de faire une copie au préalable... &#91;Édition&#93; je viens de lire ton post et mon code va planter aussi. Je le revoie.....

MFerrand · Answer

J'ai donc l'erreur d'exécution '6': Dépassement de capacité qui apparaît en exécutant la macro. Pour ça : remplacer i% et n% par i& et n& Pas encore eu le temps de revoir, mon infirmière sort mais je dois rester allongé 2 heures..., elle avait l'air de marcher mais j'ai vu après coup qu'elle ne faisait pas le nombre de lignes prévues. Pour ça que je l'ai enlevé pensant une erreur sur le compte de lignes... A+...

ThauThème · Answer

Re,

le code modifié avec les variables appropriées. Comme Transpose a des limites, j'ai tout renvoyé un par un. Ça sera bien évidement beaucoup plus long...

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim NdC As Byte 'déclare la variable NdC (Nombre de Cas)

Set O = Sheets("Feuil1") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellules TC
NC = UBound(TC, 2) 'définit le nombre de colonnes NC du tableau de cellules TC
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellules TC (en partant de la seconde)
    For NdC = 1 To TC(I, 1) 'boucle 2 : sur le nombre de cas (indiqué dans la valeur ligne I colonne 1 de TC)
        ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonnes, K colonnes)
        For J = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
            TL(J, K) = TC(I, J) 'récupère dans la ligne J de TL la valeur de la colonne J de TCransposition)
        Next J 'prochaine colonne de la boucle 3
        K = K + 1 'incrémente K (ajoute une colonne à TL)
    Next NdC 'prochain cas de la boucle 2
Next I 'prochaine ligne de la boucle 3
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
For I = 1 To UBound(TL, 2) 'boucle 1 : sur toutes les colonnes I de TL
    For J = 1 To UBound(TL, 1) 'boucle 1 : sur toutes les lignes J de TL
        O.Cells(I + 1, J).Value = TL(J, I) 'renvoie dans la cellule ligne I + 1 colonne J de l'onglet O la valeur ligne J colonne I de TL
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine colonne de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

MFerrand · Answer

J'avais effectivement un 2 à la place d'un 1... Tu as eu d'autres réponses, je vois. Je la remets car ce n'est pas la même méthode qui est utilisée. Je procède par insertion directe dans la liste...

Sub dupliquer()
    Dim n&, i&
    With ActiveSheet
        n = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = n To 2 Step -1
            If .Cells(i, 1).Value > 1 Then
                .Range(Cells(i, 1), Cells(i, 5)).Copy
                .Range(Cells(i + 1, 1), Cells(i + .Cells(i, 1).Value - 1, 5)).Rows.Insert xlShiftDown
            End If
        Next i
    End With
    Application.CutCopyMode = False
End Sub

Cordialement

Ferrand