Option Explicit
Sub Transh()
Dim Source As ListObject
Dim Target As ListObject
Dim Target_Name As String
Set Source = Range("Tableau1").ListObject
On Error Resume Next
Target_Name = "Tableau2"
Range(Target_Name).ListObject.Delete
On Error GoTo 0
Dim S As Range
Set S = Source.ListColumns("Réf").Range.Rows(Source.Range.Rows.Count).Offset(5)
S.Resize(, 3).Value = Array("Réf", "Qté 1", "Prix 1")
ActiveSheet.ListObjects.Add(xlSrcRange, S.Resize(1, 3), , xlYes).Name = Target_Name
Set Target = Range(Target_Name).ListObject
Dim J As Integer
Dim N As Integer
Dim Idx As Integer
Dim Réf As Variant
For J = 1 To Source.DataBodyRange.Rows.Count
If Source.ListColumns("Réf").DataBodyRange.Rows(J) <> Réf Then
Réf = Source.ListColumns("Réf").DataBodyRange.Rows(J)
Idx = Target.ListRows.Add.Index
Target.ListColumns("Réf").DataBodyRange.Rows(Idx) = Réf
N = 1
Else
N = N + 1
Set S = Target.HeaderRowRange.Find("Qté " & N, lookat:=xlWhole)
If S Is Nothing Then
Set S = Target.HeaderRowRange.Find("Qté " & N - 1, lookat:=xlWhole)
Target.ListColumns.Add(S.Column + 1).Name = "Qté " & N
Set S = Target.HeaderRowRange.Find("Prix " & N - 1, lookat:=xlWhole)
Target.ListColumns.Add(S.Column + 1).Name = "Prix " & N
End If
End If
Target.ListColumns("Qté " & N).DataBodyRange.Rows(Idx) = Source.ListColumns("Qté").DataBodyRange.Rows(J)
Target.ListColumns("Prix " & N).DataBodyRange.Rows(Idx) = Source.ListColumns("Prix").DataBodyRange.Rows(J)
Next
End Sub