Bonjour,
Une proposition à étudier.
Les données sont mises sous de tableau (normalisé) avec un TCD pour exemple.
Cdlt.
Option Explicit
Public Sub ConsolidateData()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim tbl, Arr()
Dim lo As ListObject
Dim rStart As Range
Dim I As Long, J As Long, k As Long
Dim x As String, y As String, z As String
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Set wsData = wb.Worksheets("Données")
Set wsPT = wb.Worksheets("TCD")
Set lo = wsPT.ListObjects(1)
If Not lo.DataBodyRange Is Nothing Then lo.DataBodyRange.Delete
Set rStart = lo.InsertRowRange.Cells(1): k = 0
With wsData
tbl = .Cells(1).CurrentRegion
For I = 2 To UBound(tbl, 1)
If Not IsDate(tbl(I, 1)) Then
x = tbl(I, 1)
y = tbl(I, 2)
z = tbl(I, 3)
End If
For J = 1 To UBound(tbl, 2)
ReDim Preserve Arr(6, k + 1)
If Not IsDate(tbl(I, 1)) Then
k = k - 1
Exit For
End If
Arr(0, k) = CLng(tbl(I, 1))
Arr(1, k) = x
Arr(2, k) = y
Arr(3, k) = z
Arr(4, k) = tbl(I, 2)
Arr(5, k) = tbl(I, 3)
Next J
k = k + 1
Next I
End With
rStart.Resize(UBound(Arr, 2), 6).Value = Application.Transpose(Arr)
With wsPT
.Activate
.PivotTables(1).PivotCache.Refresh
End With
Set rStart = Nothing
Erase Arr()
Set lo = Nothing
Set wsPT = Nothing: Set wsData = Nothing
Set wb = Nothing
End Sub