' merci à Jean-Eric
' https://forum.excel-pratique.com/viewtopic.php?f=2&t=118437
' modifier par Andre13
' code à placer dans Feuil1
Public Sub Create_list()
'Exécution procédure : Ctrl+m
Dim tbl, arr()
Dim I As Long, J As Long, k As Long
tbl = Feuil1.Cells(1).CurrentRegion.Value
ReDim arr(LBound(tbl) To UBound(tbl) * 5)
For I = LBound(tbl) To UBound(tbl)
For J = 1 To 5
arr(k + 1) = tbl(I, 1)
k = k + 1
Next J
Next I
With Feuil1
.Cells(2).CurrentRegion.ClearContents
If k > 0 Then .Cells(2).Resize(k).Value = Application.Transpose(arr)
End With
End Sub