Sub Totalisation2()
For s = 1 To Sheets.Count
Set f1 = Sheets(s)
a = f1.Range("A2:G" & f1.[A65000].End(xlUp).Row)
Dim c()
ReDim c(1 To UBound(a, 1), 1 To 3)
Maxligne = 0
Set mondico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
clé = Application.Trim(a(i, 4))
If Not mondico.exists(clé) Then
Maxligne = Maxligne + 1: mondico.Add clé, Maxligne: c(Maxligne, 1) = clé: lig = Maxligne
Else
lig = mondico.Item(clé)
End If
If a(i, 7) = "C" Then c(lig, 2) = c(lig, 2) + a(i, 5)
If a(i, 7) = "NC" Then c(lig, 3) = c(lig, 3) + a(i, 5)
Next
f1.[M2].Resize(mondico.Count, UBound(c, 2)) = c
Next s
End Sub