Private Sub Worksheet_Activate()
Set d = CreateObject("Scripting.Dictionary")
Set f = Sheets("liste occupants")
For Each c In f.Range("a2", f.[a65000].End(xlUp))
d(c.Value) = d(c.Value) & c.Offset(, 1).Value & ";"
Next c
Set f = Sheets("liste locaux")
For Each c In f.Range("a2", f.[a65000].End(xlUp))
If d.exists(c.Value) Then
c.Offset(, 3) = UBound(Split(d(c.Value), ";"))
c.Offset(, 4) = Left(d(c.Value), Len(d(c.Value)) - 1)
Else
c.Offset(, 3) = "vide": c.Offset(, 4) = "aucun"
End If
Next c
End Sub