Sub Extraire()
Dim Pl As Range, Pl_Nom(), T, T2, dico, i As Long, j As Long, Nb As Double
Set Pl = Range("E1").CurrentRegion
Set Pl = Pl.Offset(1, 0).Resize(Pl.Rows.Count - 1, Pl.Columns.Count)
Range("L3:N" & Pl.Rows.Count).ClearContents
Pl_Nom = Range("H2:H" & Pl.Rows.Count + 1)
Set dico = CreateObject("scripting.dictionary")
For i = LBound(Pl_Nom) To UBound(Pl_Nom)
If Pl(i, 5) = [M1] Then dico(Pl_Nom(i, 1)) = dico(Pl_Nom(i, 1)) + 1
Next i
T = dico.keys
T2 = dico.items
[M3].Resize(dico.Count) = Application.Transpose(T)
[L3].Resize(dico.Count) = Application.Transpose(T2)
For i = LBound(T) To UBound(T)
For j = LBound(Pl_Nom) To UBound(Pl_Nom)
If Pl_Nom(j, 1) = T(i) And Pl(j, 5) = [M1] Then Nb = Nb + Pl(j, 3)
Next j
Cells(i + 3, 14) = Nb: Nb = 0
Next i
End Sub