Sub Liste()
Dim P As Range, ncol%, an%, i&, j%, mes$, n&
Set P = Feuil1.UsedRange 'CodeName de la feuille
ncol = P.Columns.Count
an = Year(Date)
For i = 2 To P.Rows.Count
For j = 2 To ncol
If IsDate(P(i, j)) Then If Year(P(i, j)) = an Then _
mes = mes & ", " & P(i, 1).Text: n = n + 1: Exit For
Next j
Next i
MsgBox n & " noms en " & an & " :" & vbLf & Mid(mes, 3)
End Sub