Option Explicit
Sub regrouper()
Dim a, i As Long, j As Long, n As Long, txt As String, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Range("a2").CurrentRegion.Value
n = 1
For i = 2 To UBound(a, 1) - 1
txt = Join(Array(a(i, 3), a(i, 4)), Chr(2))
If Not dico.exists(txt) Then
n = n + 1: dico(txt) = n
For j = 1 To UBound(a, 2)
a(n, j) = a(i, j)
Next
Else
a(dico(txt), 5) = a(dico(txt), 5) + a(i, 5)
End If
Next
With Sheets.Add().Cells(1).Resize(n, 5)
.Value = a
With .Offset(.Rows.Count, .Columns.Count - 1).Resize(1, 1)
.Formula = "=sum(r2c:r[-1]c)"
End With
End With
End Sub