Dupliquer Ligne Si valeur >1

Bonjour,

J'ai une table avec une multitude de valeur.

J'aimerais dupliquer cette table dans une nouvelle feuille sans certaine colonne

Dans la colonne nbre, il y a des valeurs > et = à 1.

lorsque la colonne nbre est >1 on duplique la ligne (N-1) fois . exemple si 3 alors on duplique 2 fois la ligne, on retrouvera 3 fois cette ligne dans le tableau

voir fichier joint

Le tableau peut avoir x colonne

Merci de votre aide

bonjour

un essai sans convictions

cordialement

bonjour,

solution via une macro

Sub aargh()
Set ws2 = Sheets("sheet2")
ws2.Cells.Clear
 With Sheets("sheet1")
  dl = .Cells(.Rows.Count, 1).End(xlUp).Row
  k = 1
  .Rows(1).Copy ws2.Rows(1)
  For i = 2 To dl
   k = k + 1
   .Rows(i).Copy ws2.Rows(k)
   If .Cells(i, 2) > 1 Then
    k = k + 1
    .Rows(i).Copy ws2.Rows(k)
   End If
  Next i
 End With
 ws2.Columns("B").Delete shift:=xlToLeft
End Sub

Bonjour veste,

voyez si le fichier joint correspond à votre demande

Bonjour,

Merci à tous pour vos réponses.

Je cherche une solution VBA pour automatiser par BP l'exportation dans une nouvelle feuille.

H2S4 n'est pas loin de la solution.

Je pense que je me suis mal exprimé.

Je dois trouvé autant de ligne que le nombre inscrit dans la colonne Nbre.

si 8 dans la colonne Nbre, je dois alors retrouvé 8 lignes

Merci

Bonsoir,

voici le code adapté

Sub aargh()
Set ws2 = Sheets("sheet2")
ws2.Cells.Clear
 With Sheets("sheet1")
  dl = .Cells(.Rows.Count, 1).End(xlUp).Row
  k = 2
  .Rows(1).Copy ws2.Rows(1)
  For i = 2 To dl
   k1 = k + .Cells(i, 2) - 1
   .Rows(i).Copy ws2.Rows(k & ":" & k1)
   k = k1 + 1
  Next i
 End With
 ws2.Columns("B").Delete shift:=xlToLeft
End Sub

Bonjour H2S04,

en faite mon tableau est une table et il faudrait que la macro pointe cette table plutôt que la feuille.

Je pensais que j'allais pouvoir l'adapter en prenant le temps nécessaire mais étant novice en VBA, je séche complétement!

Je joint un nouveau fichier avec une table, merci de ton aide.

bonjour,

solution avec une table

Sub aargh()
    Set ws2 = Sheets("sheet2")
    ws2.Cells.Clear
    With Sheets("sheet1")
        fl = .Cells(1, 1).End(xlDown).Row
        dl = .Cells(.Rows.Count, 1).End(xlUp).Row
        k = 2
        .Rows(fl).Copy ws2.Rows(1)
        For i = fl + 1 To dl
            k1 = k + .Cells(i, 2) - 1
            .Rows(i).Copy ws2.Rows(k & ":" & k1)
            k = k1 + 1
        Next i
    End With
    ws2.Columns("B").Delete Shift:=xlToLeft
    lc = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
    ws2.ListObjects.Add(xlSrcRange, ws2.Range("A1", ws2.Cells(k - 1, lc)), , xlYes).Name = "taches"
    ws2.ListObjects("Taches").TableStyle = "TableStyleLight2"
End Sub

Bonjour,

Merci de votre aide, j'ai pu adapter ce code à mon fichier.

Je m'en rend compte que la programmation est trés chronophage quand on est novice en la matiére!

Vos solutions me permettent d'avancer et de comprendre un peu plus le VBA

Encore merci.