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

[oakd]

Bonjour à tous,

Je sollicite votre aide pour modifier la disposition de tableaux :

• transposer en colonne des lignes situées en fin de tableau et les placer sous chaque ligne
• étendre vers le bas les données des autres colonnes

Ci-joint un exemple pour bien comprendre. Je ne sais pas s’il est obligatoire de créer une macro ou si c’est faisable avec un outil comme Kutools (pour ceux qui connaissent).

Le but final est d’avoir un tableau où l’on puisse trier les données.

 

[chris]

Bonjour

Faisable par PowerQuery intégré à Excel

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

Si la source évolue, Données, Actualiser tout

 

[mapomme]

Bonjour @oakd, @chris 🙂,

Une version par VBA. La feuille du résultat "Result" est mise à jour chaque fois qu'on l'active.
Le code est dans le module de la feuille "Result" :

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