XL 2019 Macro somme plusieurs lignes

Sub DicoDoublonSommeLaurent950()
Dim TI As Single
'    TI = Timer
' ***************************************************
'Dim d As New Scripting.Dictionary
Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = TextCompare
Dim cef As String
' ***************************************************
Dim Tb() As Variant
Dim ShF1 As Worksheet
    Set ShF1 = Worksheets("F1")
    Tb = ShF1.Range(ShF1.Cells(1, 7), ShF1.Cells(ShF1.Cells(65536, 7).End(xlUp).Row, 35))
Dim i, j, cpt As Double
' ***************************************************
Dim TabRes() As Variant
ReDim TabRes(1 To 26, 1 To 1)
' ***************************************************
Dim ShPP1 As Worksheet
    Set ShPPI = Worksheets("PPI")
    ShPPI.Range(ShPPI.Cells(2, 5), ShPPI.Cells(ShPPI.Cells(65536, 5).End(xlUp).Row + 1, 30)).Interior.Pattern = xlNone
    ShPPI.Range(ShPPI.Cells(2, 5), ShPPI.Cells(ShPPI.Cells(65536, 5).End(xlUp).Row + 1, 30)).ClearContents
' ***************************************************
    For i = LBound(Tb) + 1 To UBound(Tb) ' Commence à la ligne 2 (LBound(Tb) + 1)
        clef = Tb(i, 1) & Tb(i, 4)
        If d.Exists(clef) Then
            cpt = d(clef)
                For j = 7 To 29
                    TabRes(j - 3, cpt) = TabRes(j - 3, cpt) + Tb(i, j)
                Next j
                ' Option Repérage de la ligne en doublon avec (Couleur de la ligne)
                ' LIBELLE & Article (doublons) = Couleur
                    With ShPPI.Range(ShPPI.Cells(cpt + 1, 5), ShPPI.Cells(cpt + 1, 30)).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = 2
                        .ThemeColor = xlThemeColorAccent2
                        .TintAndShade = 0.799981688894314
                        .PatternTintAndShade = 0
                    End With
        Else
            cpt = d.Count + 1
            d(clef) = cpt
                TabRes(1, cpt) = Tb(i, 1) ' LIBELLES
                TabRes(3, cpt) = Tb(i, 4) ' Article
                For j = 7 To 29           ' SOMME 1 à 23
                    TabRes(j - 3, cpt) = Tb(i, j)
                Next j
            ReDim Preserve TabRes(1 To 26, 1 To (cpt + 1))
        End If
    Next i
ShPPI.[E2].Resize(UBound(TabRes, 2), UBound(TabRes, 1)) = Application.Transpose(TabRes)
'MsgBox Format(Timer - TI, "0.000\ sec.")
End Sub