Dupliquer des lignes Excel en BVA avec une valeur multiplicateur Résolu

Question

Bonjour,
Après lecture du post fait sur le même thème, "EXCEL copier les lignes par un multiplicateur", je n'arrive pas à adapter la macro proposée pour mon cas... Désolé mon VBA est resté coincée avant l'an 2000 ... :)
J'ai une table sur une feuille 1 (les valeurs vont de (A2;J523) hors la ligne 1 qui sont mes en têtes) et j'ai besoin que les lignes soient dupliquées sur un autre onglet (feuille 2) autant de fois que mentionnées dans la colonne D
J'ai dupliqué la ligne d'en tête sur la feuille 2

Quelqu'un pourrait-il me pointer les modifications à opérer ?
Merci d'avance 

Voici la macro proposée par michel_m

Option Explicit 

Sub dupliquer_n_fois() 
Dim Derlig1 As Long, Lig As Long, Nbre As Integer, T_in() 
Dim Derlig2 As Long 

Application.ScreenUpdating = False 
Sheets(2).Range("A2:D30000").Clear 

With Sheets(1) 
     Derlig1 = .Columns("A").Find("*", , , , , xlPrevious).Row 
     For Lig = 2 To Derlig1 
          Nbre = .Cells(Lig, "E") 
          T_in = .Range(.Cells(Lig, "A"), .Cells(Lig, "D")).Value 
           
          With Sheets(2) 
               Derlig2 = .Columns("A").Find("", .Range("A1")).Row 
               .Cells(Derlig2, "A").Resize(Nbre, 4) = T_in 
          End With 
     Next 
End With 
Sheets(2).Select 
End Sub

f894009 · Answer

Bonjour,

Option Explicit

Sub dupliquer_n_fois()
    Dim Derlig1 As Long, Lig As Long, Nbre As Integer, T_in()
    Dim Derlig2 As Long
    
    'les valeurs vont de (A2;J523)
    'autant de fois que mentionnées dans la colonne D
    
    Application.ScreenUpdating = False
    With Sheets(2)
        Derlig2 = .Columns("A").Find("", .Range("A1")).Row
        .Range("A2:J" & Derlig2).Clear
    End With
    With Sheets(1)
        Derlig1 = .Columns("A").Find("*", , , , , xlPrevious).Row
        For Lig = 2 To Derlig1
            Nbre = .Cells(Lig, "D")
            T_in = .Range(.Cells(Lig, "A"), .Cells(Lig, "J")).Value
            With Sheets(2)
                Derlig2 = .Columns("A").Find("", .Range("A1")).Row
                .Cells(Derlig2, "A").Resize(Nbre, 10) = T_in
            End With
        Next Lig
    End With
    Sheets(2).Select
End Sub

Dupliquer des lignes Excel en BVA avec une valeur multiplicateur

1 réponse

Discussions similaires

Newsletters