Comment générer automatiquement un nombre de lignes en fonction de certaines valeurs

Sub Test()
Feuil1.Select
j = Feuil2.Range("A65536").End(xlUp).Row + 1
For k = 2 To 5
For i = 1 To Feuil1.Cells(k, 4)
    Feuil2.Cells(j, 1) = Feuil1.Cells(k, 1)
    Feuil2.Cells(j, 2) = Feuil1.Cells(k, 2)
    Feuil2.Cells(j, 3) = Feuil1.Cells(k, 3)
j = j + 1
Next
Next
End Sub

Sub Export()
Dim i&, j&, k&, T(), Tmp()
ReDim Preserve T(1 To 3, 0 To 0)
With Sheets("Feuil1")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        For j = 1 To .Cells(i, 4)
            ReDim Preserve T(1 To 3, 0 To UBound(T, 2) + 1)
            For k = 1 To 3
                T(k, UBound(T, 2)) = .Cells(i, k)
            Next k
        Next j
    Next i
End With
With Sheets("Feuil2")
    Tmp = .Range(.Cells(1, 1), .Cells(1, 3)).Value
    .Columns("A:C").ClearContents
    .Cells(1, 1).Resize(UBound(T, 2) + 1, 3) = Application.Transpose(T)
    .Range(.Cells(1, 1), .Cells(1, 3)).Value = Tmp
End With
End Sub

Sub Export_2()
Dim i&, j&, k&, x&, L&, T(), Plg(), LstRng As Range
With Sheets("Feuil1")
    Set LstRng = .Cells(Rows.Count, 1).End(xlUp).Offset(0, 3)
    x = WorksheetFunction.Sum(.Range("D2:" & LstRng.Address))
    Plg = .Range(.Cells(2, 1), LstRng).Value
End With
 
If x = 0 Then Exit Sub
ReDim T(1 To x, 1 To 3)
For i = LBound(Plg, 1) To UBound(Plg, 1)
    For j = 1 To Plg(i, 4)
        L = L + 1
        For k = 1 To 3
            T(L, k) = Plg(i, k)
        Next k
    Next j
Next i
 
With Sheets("Feuil2")
    .Range(.Cells(2, 1), .Cells(Rows.Count, 3).End(xlUp)(2)).ClearContents
    .Cells(2, 1).Resize(L, 3) = T
End With
End Sub