Sub Test_Efge_3()
Dim dest As Range, critere$, t As Variant, d As Object, i&
Set dest = [H8] 'à adapter
critere = [I6] & [I5] & "OUI" 'à adapter
t = Range(Cells(2, 1), Cells(Rows.Count, 1).End(3)(1, 5))
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(t)
If t(i, 1) <> "" And t(i, 2) & t(i, 3) & UCase(t(i, 5)) = critere Then
If Not d.exists(t(i, 1)) Then
d(t(i, 1)) = d.Count + 1
t(d(t(i, 1)), 1) = t(i, 1)
t(d(t(i, 1)), 2) = 0
t(d(t(i, 1)), 3) = 0
End If
t(d(t(i, 1)), 2) = t(d(t(i, 1)), 2) + t(i, 4)
If t(i, 4) > 0 Then t(d(t(i, 1)), 3) = t(d(t(i, 1)), 3) + 1
End If
Next i
dest.Resize(UBound(t, 1), 3).ClearContents
Application.ScreenUpdating = False
If d.Count Then
With dest.Resize(d.Count, 3)
.Value = t
.Sort dest, xlAscending, Header:=xlNo 'tri
End With
End If
Application.ScreenUpdating = True 'erreur dans le code précédent(remettre à True)
End Sub