Microsoft 365 Comment dupliquer des lignes autant de fois que l'indication d'une cellule?

[TheoAngel10]

Bonjour,
J'ai dans un tableau 8 colonnes. Je souhaite reproduire chaque ligne en fonction du nb indiqué dans la colonne H à l'identique pour les colonnes A à G et ceci chaque fois que la valeur est supérieur à 1.
Auriez-vous une idée de code vba ou formule excel qui permette de faire ceci?
Par avance merci pour votre aide.
Je débute en vba et excel. Je veux utiliser ce fichier pour un travail sur R.
TL

 

[vgendron]

Hello

Avec ce code par exemple..

Sub recopie()
Application.ScreenUpdating = False
Dim tabdata() As Variant
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabdata = .Range("A1:H" & fin).Value
End With
Sheets.Add.Name = "Result"
With Sheets("Result")
    indfeuille = 1
    For j = LBound(tabdata, 2) To UBound(tabdata, 2) - 1
        .Cells(indfeuille, j) = tabdata(1, j)
    Next j
    For i = LBound(tabdata, 1) + 1 To UBound(tabdata, 1)
        For cpt = 1 To tabdata(i, 8)
            indfeuille = indfeuille + 1
            For j = LBound(tabdata, 2) To UBound(tabdata, 2) - 1
                .Cells(indfeuille, j) = tabdata(i, j)
            Next j
        Next cpt
    Next i
End With
Application.ScreenUpdating = True
End Sub

vu la quantité de lignes, c'est un peu long..
peut etre qu'en créant un tablofinal plutot que copier directement dans la feuille..

 

[vgendron]

un peu plus rapide :-D

Sub recopie()
Application.ScreenUpdating = False
Dim tabdata() As Variant
Dim tabfinal() As Variant
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    NbFinal = Application.WorksheetFunction.Sum(Range("H2:H" & fin))
    tabdata = .Range("A1:H" & fin).Value
    ReDim tabfinal(1 To NbFinal + 1, 1 To 7)
End With

    indfeuille = 1
    For j = LBound(tabdata, 2) To UBound(tabdata, 2) - 1
        tabfinal(indfeuille, j) = tabdata(1, j)
    Next j
    For i = LBound(tabdata, 1) + 1 To UBound(tabdata, 1)
        For cpt = 1 To tabdata(i, 8)
            indfeuille = indfeuille + 1
            For j = LBound(tabdata, 2) To UBound(tabdata, 2) - 1
                tabfinal(indfeuille, j) = tabdata(i, j)
            Next j
        Next cpt
    Next i
Sheets.Add.Name = "Result"
With Sheets("Result")
    .Range("A1").Resize(UBound(tabfinal, 1), UBound(tabfinal, 2)) = tabfinal
End With
Application.ScreenUpdating = True
End Sub

 

[TheoAngel10]

un peu plus rapide :-D

Sub recopie()
Application.ScreenUpdating = False
Dim tabdata() As Variant
Dim tabfinal() As Variant
With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    NbFinal = Application.WorksheetFunction.Sum(Range("H2:H" & fin))
    tabdata = .Range("A1:H" & fin).Value
    ReDim tabfinal(1 To NbFinal + 1, 1 To 7)
End With

    indfeuille = 1
    For j = LBound(tabdata, 2) To UBound(tabdata, 2) - 1
        tabfinal(indfeuille, j) = tabdata(1, j)
    Next j
    For i = LBound(tabdata, 1) + 1 To UBound(tabdata, 1)
        For cpt = 1 To tabdata(i, 8)
            indfeuille = indfeuille + 1
            For j = LBound(tabdata, 2) To UBound(tabdata, 2) - 1
                tabfinal(indfeuille, j) = tabdata(i, j)
            Next j
        Next cpt
    Next i
Sheets.Add.Name = "Result"
With Sheets("Result")
    .Range("A1").Resize(UBound(tabfinal, 1), UBound(tabfinal, 2)) = tabfinal
End With
Application.ScreenUpdating = True
End Sub

Un grand merci pour votre aide. Pour l'instant il y a deux bénéficiaires qui se sont rajoutés. A quoi cela pourrait être dû? Je devrais avoir 50 898 lignes + une de titre

 

[vgendron]

pourquoi 50898 ??
dans ton fichier de départ, la somme de la colonne H est bien de 50900 + l'entete
et c'est le nombre de lignes au final + l'entete

 

[TheoAngel10]

pourquoi 50898 ??
dans ton fichier de départ, la somme de la colonne H est bien de 50900 + l'entete
et c'est le nombre de lignes au final + l'entete

Excusez moi. A force de retravailler mes données, j'ai ajouté deux lignes. J'ai repris mon fichier de base et j'ai appliqué votre code. J'arrive bien au bon nombre.
Encore une fois un grand merci