EXCEL copier les lignes par un multiplicateur si 1 valeur nulle

Résolu/Fermé

dlcmbe58 - 9 mars 2016 à 17:42
dlcmbe58 Messages postés 1 Date d'inscription mercredi 9 mars 2016 Statut Membre Dernière intervention 9 mars 2016 - 9 mars 2016 à 18:01

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.

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.

A voir également:

EXCEL copier les lignes par un multiplicateur si 1 valeur nulle
Liste déroulante excel - Guide
Si et excel - Guide
Aller à la ligne excel - Guide
Formule excel - Guide
Copier une vidéo youtube - Guide

1 réponse

Réponse 1 / 1

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
9 mars 2016 à 17:56

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+

dlcmbe58 Messages postés 1 Date d'inscription mercredi 9 mars 2016 Statut Membre Dernière intervention 9 mars 2016
9 mars 2016 à 18:01

Parfait, je viens de tester ça marche nickel. Merci !!! :-)

Discussions similaires

Formule Excel : "SI" une cellule contient un mot, alors ?

Afficher toutes les lignes masquées excel

Dessiner avec son clavier et avec des lettres

recopier une formule sans décalage

Discussions similaires

Newsletters