Re,
j'ai copier/coller le code que tu as mis dans ta réponse, et ça ne fonctionne pas
voilà ce que ça donne :
Option Explicit
Private Sub cmdGO_Click()
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim lCol As Long, lRow As Long
Dim Num As Long, rw As Long
Dim I As Long
Dim rCell As Range
Application.ScreenUpdating = False
Set ws = ActiveSheet: Set lo = ws.ListObjects(1)
Set ws2 = Worksheets("Feuil3"): Set lo2 = ws2.ListObjects(1)
If Not lo2.DataBodyRange Is Nothing Then lo2.DataBodyRange.Delete
With lo
lCol = lo.ListColumns.Count
lRow = lo.DataBodyRange.Rows.Count
For rw = 1 To lRow
Num = lo.DataBodyRange.Cells(rw, lCol)
For I = 1 To Num
If Not lo2.InsertRowRange Is Nothing Then
Set rCell = lo2.InsertRowRange.Cells(2)
Else
Set rCell = lo2.HeaderRowRange.Cells(2).Offset(lo2.ListRows.Count + 1)
End If
lo.DataBodyRange.Cells(rw, 1).Offset(0, 1).Resize(1, 4).Copy
rCell.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next I
Next rw
End With
Set rCell = Nothing
Set lo2 = Nothing: Set lo = Nothing
Set ws2 = Nothing: Set ws = Nothing
End Sub
voilà merci pour ton aide.
cdlt
Arkheos