Totalisation valeur SubItems suivant Items Identiques dans une ListView

Private Sub CommandButton1_Click()
Dim d As Object, Ta, Tb() As Variant, x As Long, i As Long, j As Long
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To ListView1.ListItems.Count
    v = ListView1.ListItems(i).Text
    If Not d.exists(v) Then d.Add v, v
Next i
x = 1
Ta = d.items
For i = 0 To UBound(Ta)
    For j = 1 To ListView1.ListItems.Count
        If ListView1.ListItems(j) = Ta(i) Then
            ReDim Preserve Tb(1 To 2, 1 To x)
            Tb(1, x) = ListView1.ListItems(j)
            Tb(2, x) = CDbl(Tb(2, x)) + CDbl(ListView1.ListItems(j).SubItems(1))
        End If
    Next
    x = x + 1
Next
Range(Cells(5, 7), Cells(UBound(Tb, 2) + 4, 8)) = Application.Transpose(Tb)

End Sub

Private Sub CommandButton1_Click()
LIGNE_FEUILLE = 5

 For i = 1 To Me.ListView1.ListItems.Count
 On Error Resume Next ' (Pour ne pas d'aller au-delà du nombre d'Items avec le "+1")
 
 CHIFFRE_JOUR = CHIFFRE_JOUR + CDbl(Me.ListView1.ListItems(i).ListSubItems(1).Text)
 
    If Me.ListView1.ListItems(i).Text <> Me.ListView1.ListItems(i + 1).Text Then

      ActiveSheet.Cells(LIGNE_FEUILLE, 7).Value = Me.ListView1.ListItems(i).Text
      ActiveSheet.Cells(LIGNE_FEUILLE, 8).Value = CHIFFRE_JOUR
      CHIFFRE_JOUR = 0
      LIGNE_FEUILLE = LIGNE_FEUILLE + 1
   
    End If
 
 Next i

End Sub