tableau de synthèse (macro)

Option Explicit
Sub test()
Dim a, w(), i As Long, j As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("Base de données")
        a = .Range("b3").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If Not dico.exists(a(i, 2)) Then
                Set dico(a(i, 2)) = _
                CreateObject("Scripting.Dictionary")
            End If
            If Not dico(a(i, 2)).exists(a(i, 3)) Then
                dico(a(i, 2))(a(i, 3)) = VBA.Array(a(i, 2), a(i, 3), Empty)
            End If
            w = dico(a(i, 2))(a(i, 3))
            w(2) = w(2) + a(i, 4)
            dico(a(i, 2))(a(i, 3)) = w
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("synthèse1").Range("b2")
        .CurrentRegion.Offset(1).Clear
        n = 1
        For i = 0 To dico.Count - 1
            For j = 0 To dico.items()(i).Count - 1
                With .Offset(n).Resize(1, UBound(dico.items()(i).items()(j), 1) + 1)
                    .Value = dico.items()(i).items()(j)
                End With
                n = n + 1
            Next
        Next
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Columns.AutoFit
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim T(), Réf As SsGr, Lot As SsGr, L As Long
ReDim T(1 To 1000, 1 To 3)
For Each Réf In Gigogne(Feuil1.[B4:E4], 1, 3)
   For Each Lot In Réf.Co
      L = L + 1
      T(L, 1) = Réf.Id
      T(L, 2) = Lot.Id
      T(L, 3) = Lot.Somme(4)
      Next Lot, Réf
Me.[B3].Resize(UBound(T, 1), UBound(T, 2)).Value = T
End Sub

Option Explicit

Private Sub Worksheet_Activate()
Dim T(), Réf As SsGr, L As Long
ReDim T(1 To 1000, 1 To 3)
For Each Réf In Gigogne(Feuil1.[B4:E4], 1)
   L = L + 1
   T(L, 1) = Réf.Id
   T(L, 2) = Réf.Co(1)(2)
   T(L, 3) = Réf.Somme(4)
   Next Réf
Me.[B3].Resize(UBound(T, 1), UBound(T, 2)).Value = T
End Sub