Option Explicit
Sub CompteCisParRegime()
Dim Listeunique As Collection
Dim x As Integer
Dim Cell As Range
Dim xTemp As String
Dim nbLigne As Long
Set Listeunique = New Collection
On Error Resume Next
Sheets("Feuil1").Select
nbLigne = [A65000].End(xlUp).Row
Range("B2:B" & nbLigne).Select
For Each Cell In Selection
xTemp = Cell.Value & ";" & Cell.Offset(, 1).Value
Listeunique.Add xTemp, CStr(xTemp)
If Err <> 0 Then
Err.Clear
End If
Next
Sheets("feuil2").Select
For x = 1 To Listeunique.Count
Cells(x + 1, 1) = Split(Listeunique.Item(x), ";")(0)
Cells(x + 1, 2) = Split(Listeunique.Item(x), ";")(1)
Cells(x + 1, 3).FormulaR1C1 = "=SUMPRODUCT((Feuil1!R2C2:R" & nbLigne & "C2=Feuil2!RC1)*(Feuil1!R2C3:R" & nbLigne & "C3=Feuil2!RC2))"
Next x
End Sub