XL 2013 Macro qui duplique les lignes d'un tableau en fonction d'un nombre précis

[onyirimba]

Bonjour,

Je souhaiterai obtenir une Macro/VBA qui créée un autre tableau (tableau ci dessous en partie basse) en dupliquant les lignes (du tableau de la partie haute) en fonction du nombre indiqué en colonne O du fichier Excel ci joint.
ex : si le chiffre est 3 en colonne O => il y aura 3 lignes dans le nouveau tableau etc...
J'ai joint un fichier Excel illustrant ma demande.

Merci de votre aide

Cordialement

 

[Staple1600]

Bonjour @onyirimba, le fil

@onyirimba
Test OK sur mon PC (Office 365)
NB: Test fait sur une feuille ne contenant qu'un seul tableau structuré

Sub Dupliquer_Lignes_Tableau()
Dim tbl As ListObject, derLg&, i&, j&, nbCopies%
Application.ScreenUpdating = False
Set tbl = ActiveSheet.ListObjects(1)
derLg = tbl.ListRows.Count
For i = derLg To 1 Step -1
    nbCopies = tbl.ListRows(i).Range.Cells(1, "O").Value
    If IsNumeric(nbCopies) And nbCopies > 1 Then
        For j = 1 To nbCopies - 1
            tbl.ListRows.Add (i + 1)
            tbl.ListRows(i).Range.Copy Destination:=tbl.ListRows(i + 1).Range
        Next j
    End If
Next i
End Sub

 

[onyirimba]

Bonjour @onyirimba, le fil

@onyirimba
Test OK sur mon PC (Office 365)
NB: Test fait sur une feuille ne contenant qu'un seul tableau structuré

Sub Dupliquer_Lignes_Tableau()
Dim tbl As ListObject, derLg&, i&, j&, nbCopies%
Application.ScreenUpdating = False
Set tbl = ActiveSheet.ListObjects(1)
derLg = tbl.ListRows.Count
For i = derLg To 1 Step -1
    nbCopies = tbl.ListRows(i).Range.Cells(1, "O").Value
    If IsNumeric(nbCopies) And nbCopies > 1 Then
        For j = 1 To nbCopies - 1
            tbl.ListRows.Add (i + 1)
            tbl.ListRows(i).Range.Copy Destination:=tbl.ListRows(i + 1).Range
        Next j
    End If
Next i
End Sub

Bonjour @Staple1600 ,
j'ai ce message d'erreur lorsque j'active la Macro sur la Feuil 1
quel es l'origine du blocage ?

Merci

 

[Staple1600]

Re

@onyirimba
Comme tu parlais de tableau, j'ai cru que ton tableau était un tableau structuré
Sélectionne tes données puis fais CTRT+L
Ensuite reteste le code VBA

 

[Staple1600]

Re

Je viens de le faire
cela fonctionne, non ?

 

[onyirimba]

bonjour @Staple1600

cela fonctionne mais lorsque j'essaie sur sur le nouveau tableau que j'ai joint à ce message j'ai ce message d'erreur
Merci d'avance de ton aide

 

[onyirimba]

Re

Je viens de le faire
cela fonctionne, non ?
Regarde la pièce jointe 1219174

cela fonctionne merci

 

[Staple1600]

Re

j'ai bien précisé ceci dans mon premier message, non ?

NB: Test fait sur une feuille ne contenant qu'un seul tableau structuré

Si il y a plusieurs tableaux, il faut modifier le code VBA en conséquence
En nommant le tableau en dur dans le code par exemple

PS: En tout logique, ce devrait être le message#2 la solution, non ?