Fusionner les données entre deux listes

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