Sub nono159()
Dim Ws1 As Worksheet, Ws2 As Worksheet, MonDico, TabBadge, TabDate, i, j
Dim DerLig1, DerLig2, MonAnnée
Set Ws1 = Worksheets("Feuil1")
Set Ws2 = Worksheets("Feuil2")
Set MonDico = CreateObject("Scripting.Dictionary")
MonAnnée = 2014
DerLig1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
DerLig2 = Ws2.Range("A" & Rows.Count).End(xlUp).Row
TabBadge = Ws1.Range("A2:C" & DerLig1)
TabDate = Ws2.Range("A2:I" & DerLig2)
For i = LBound(TabBadge) To UBound(TabBadge)
For j = LBound(TabDate) To UBound(TabDate)
If TabBadge(i, 2) = TabDate(j, 1) Then
If TabBadge(i, 3) = TabDate(j, 2) Then
If Year(TabDate(j, 9)) = MonAnnée Then
MonDico(TabBadge(i, 1)) = MonDico(TabBadge(i, 1)) + 1
End If
End If
End If
Next
Next
Ws1.Range("F2").Resize(MonDico.Count) = Application.Transpose(MonDico.keys)
Ws1.Range("G2").Resize(MonDico.Count) = Application.Transpose(MonDico.items)
End Sub