Réaliser un tableau avec le cumul de chaque produit

Option Explicit

Sub collecte()
'
' Procédure créée le 13 Brumaire CCXVII (03.11.2008)
' ROGER2327
'
Dim i As Long, j As Long, s As String
Dim c, d, r
    d = Me.Cells(1, 1).CurrentRegion                'd=Tableau des données
    ReDim r(1 To 2, 1 To 1)                         'r=Tableau des <Code produit>
    r(1, 1) = d(1, 2)                               '"Code produit"
    r(2, 1) = d(1, 3)                               '"Accessoire"
    For i = 2 To UBound(d, 1)                       'Lecture des <Code produit> dans d
        s = d(i, 2)                                 '<Code produit> dans la ligne i
        For j = 1 To UBound(r, 2)                   'Recherche de s dans r
            If r(1, j) = s Then Exit For            'Si s est déjà dans r, fin de la recherche
        Next j
        If j > UBound(r, 2) Then                    '...alors s n'est pas dans r
            ReDim Preserve r(1 To 2, 1 To j)        'Ajout d'un enregistrement à r
            r(1, j) = s                             '...auquel on affecte s
            r(2, j) = d(i, 3)                       '...et la valeur <Accessoire> associée
        End If
    Next i
    ReDim c(1 To UBound(r, 2), 1 To UBound(d, 2))   'c=Tableau de collecte
    For j = 1 To UBound(d, 2)                       'Remplissage de la première ligne de c (intitulé des colonnes)
        c(1, j) = d(1, j)
    Next j
    For i = 2 To UBound(r, 2)                       'Lecture des <Code produit> dans r
        s = r(1, i)
        c(i, 1) = "Toutes rubriques"
        c(i, 2) = s                                 'Affectation d'un <Code produit> dans la ligne i
        c(i, 3) = r(2, i)                           '...et de la valeur <Accessoire> associée
        For j = 2 To UBound(d, 1)                   'Pour chaque ligne du tableau de données...
            If d(j, 2) = s Then                     '...le <Code produit> est-il s ?
                c(i, 4) = c(i, 4) + d(j, 4)         'Si OUI, cumul des valeurs de <Sortie Usine>
                c(i, 5) = c(i, 5) + d(j, 5)         '...et de <vente magasin>
            End If
        Next j
    Next i
    With ThisWorkbook.Sheets("RECAP")               'Sortie de la collecte dans la feuille "RECAP"
        .Cells.ClearContents                        'Effacement de la collecte antérieure
        .Range(.Cells(1, 1), .Cells(UBound(c, 1), UBound(c, 2))).Value = c
        .Activate                                   'Affichage de la collecte
    End With
End Sub