Option Explicit
Sub CalcTotal()
Dim i As Long, j As Long, k As Long, Dico, Somme() As Double, Elt As Variant
Set Dico = CreateObject("Scripting.Dictionary")
ReDim Somme(1 To 1)
With Sheets("Total")
.Range("C8:D65536").ClearContents
For i = 1 To 3 'Feuilles Feuil1 à Feuil3
j = 31 'Ligne de début des données sur chaque feuille
Do Until Sheets("Feuil" & i).Cells(j, 2).Value = ""
Dico(Sheets("Feuil" & i).Cells(j, 2).Value) = 1
If Dico.Count > UBound(Somme) Then
ReDim Preserve Somme(1 To UBound(Somme) + 1)
Somme(UBound(Somme)) = CDbl(Sheets("Feuil" & i).Cells(j, 5).Value)
Else
Elt = Dico.keys
For k = LBound(Elt) To UBound(Elt)
If Elt(k) = Sheets("Feuil" & i).Cells(j, 2).Value Then
Somme(k + 1) = Somme(k + 1) + CDbl(Sheets("Feuil" & i).Cells(j, 5).Value)
Exit For
End If
Next k
End If
j = j + 1
Loop
Next i
'Ecriture résultats
Elt = Dico.keys
For i = LBound(Elt) To UBound(Elt)
.Range("C" & i + 8).Value = Elt(i)
.Range("D" & i + 8).Value = Somme(i + 1)
Next i
End With
End Sub