Microsoft 365 Modification de tableaux : transposition de lignes en colonnes sous chaque ligne

let
    Source = Excel.CurrentWorkbook(){[Name="Tableau1"]}[Content],
    PStep = Table.UnpivotOtherColumns(Source, List.FirstN(Table.ColumnNames(Source), 34), "Article", "Prix"),
    Reorder = Table.ReorderColumns(PStep,List.Combine({List.FirstN(Table.ColumnNames(PStep), 4),{"Article","Prix"},List.FirstN(List.LastN(Table.ColumnNames(PStep),List.Count(Table.ColumnNames(PStep))-4),30)}))
in
    Reorder

Private Sub Worksheet_Activate()
Dim t, i&, j&, n&, ref&
   Application.ScreenUpdating = False
   t = Sheets("Feuil1").Range("a2").ListObject.Range
   ReDim r(1 To UBound(t) * (UBound(t, 2) - 34), 1 To 3)
   For i = 2 To UBound(t)
      For j = 35 To UBound(t, 2)
         If t(i, j) <> "" Then
            n = n + 1
            r(n, 1) = t(1, j)
            r(n, 2) = t(i, j)
            r(n, 3) = i
         End If
      Next j
   Next i
   On Error Resume Next: Range("a1").ListObject.Delete: Range("a1").CurrentRegion.Delete: On Error GoTo 0
   For j = 1 To 4: Cells(1, j) = t(1, j): Next
   Cells(1, 5) = "Articles": Cells(1, 6) = "Prix"
   For j = 5 To 34: Cells(1, j + 2) = t(1, j): Next
   Range("e2").Resize(n, 2) = r
   For i = 1 To n
      If r(i, 3) <> ref Then
         For j = 1 To 4: Cells(i + 1, j) = t(r(i, 3), j): Next
         For j = 5 To 34: Cells(i + 1, j + 2) = t(r(i, 3), j): Next
         ref = r(i, 3)
      End If
   Next i
   Range("a1").Resize(n + 1, 36).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
   Range("a1").Resize(n + 1, 36).Value = Range("a1").Resize(n + 1, 36).Value
   Me.ListObjects.Add(xlSrcRange, Range("a1").Resize(n + 1, 36), , xlYes).Name = "TabRes"
End Sub