Microsoft 365 passer d'une information en ligne à une information en colonne

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