Sub MAJ()
Dim P As Range, Q As Range, Pcc%, Qrc&, i&, j%, k&, v1, v2, n%
Set P = [F5:I7] 'à adapter
Set Q = Range("F14:I" & Range("F" & Rows.Count).End(xlUp).Row) 'à adapter
Pcc = P.Columns.Count
Qrc = Q.Rows.Count
Application.ScreenUpdating = False
For i = 1 To P.Rows.Count
For j = 1 To Pcc
P(i, j) = ""
If P(i, 0) <> "" And P(0, j) <> "" Then
For k = 2 To Qrc
If (Q(k, 1) = P(0, j) Or Year(Q(k, 1)) = P(0, j)) Then
v1 = Q(k, 2).MergeArea(1) 'en cas de cellule fusionnée
If IsNumeric(CStr(v1)) Then
v2 = Q(k, 4).MergeArea(1) 'en cas de cellule fusionnée
n = InStr(v2, P(i, 0))
If n Then If Not IsNumeric(Mid(v2, n + Len(P(i, 0)), 1)) _
Then P(i, j) = P(i, j) + v1
End If
End If
Next k
End If
Next j, i
End Sub