EXCEL copier les lignes par un multiplicateur si 1 valeur nulle
Résolu
dlcmbe58
-
dlcmbe58 Messages postés 1 Statut Membre -
dlcmbe58 Messages postés 1 Statut Membre -
Bonjour,
Je souhaite copier des lignes d'une feuille à une autre autant de fois que le nombre inscrit dans la dernière colonne de la feuille 1 (ici la colonne E).
J'ai trouvé ce code ci-dessous qui fonctionne (merci à michel_m), cependant il nécessite de mettre une valeur non nulle dans la colonne E, or je souhaite pouvoir laisser une cellule vide pour ne pas que la ligne correspondante soit copier.
Merci d'avance.
Je souhaite copier des lignes d'une feuille à une autre autant de fois que le nombre inscrit dans la dernière colonne de la feuille 1 (ici la colonne E).
J'ai trouvé ce code ci-dessous qui fonctionne (merci à michel_m), cependant il nécessite de mettre une valeur non nulle dans la colonne E, or je souhaite pouvoir laisser une cellule vide pour ne pas que la ligne correspondante soit copier.
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
Merci d'avance.
1 réponse
-
Bonjour,
Il suffit de placer une condition pour le cas où Nbre est nul.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")
If Nbre > 0 Then
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
End If
Next
End With
Sheets(2).Select
End Sub
A+
