Bonsoir,
Une proposition à étudier.
Les données sont mises sous forme de tableaux (Excel 2007+).
Cdlt.
Option Explicit
Public Sub Consolidate_Data()
Dim ws As Worksheet
Dim lo As ListObject
Dim tbl, Arr()
Dim rStart As Range
Dim I As Long, J As Long, k As Long
Application.ScreenUpdating = False
With ActiveSheet.ListObjects(1)
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
Set rStart = .InsertRowRange.Cells(1)
End With
Set ws = Worksheets("SECTION")
tbl = ws.ListObjects(1).Range
For I = 2 To UBound(tbl)
For J = 2 To UBound(tbl, 2)
If tbl(I, J) <> "" Then
ReDim Preserve Arr(3, k + 1)
Arr(0, k) = tbl(I, 1)
Arr(1, k) = tbl(1, J)
Arr(2, k) = tbl(I, J)
k = k + 1
End If
Next J
Next I
rStart.Resize(UBound(Arr, 2), 3).Value = Application.Transpose(Arr)
End Sub