Maybe :

Sub Test()
  Dim coll As New Collection, collDummy As New Collection, arr, i As Long, str1 As String, v1, v2

  arr = Sheet2.Range("A1").CurrentRegion.Value
  On Error Resume Next
     For i = 2 To UBound(arr, 1)
         Set collDummy = Nothing
         str1 = arr(i, 1)
         coll.Add key:=str1, Item:=collDummy
         coll(str1).Add key:=arr(i, 2), Item:=arr(i, 2)
     Next i
  On Error GoTo 0

  With Sheet1.Range("A1").CurrentRegion
    arr = .Value
    For i = 2 To UBound(arr, 1)
        arr(i, 2) = ""
        On Error Resume Next
           Set v1 = coll(CStr(arr(i, 1)))
           If Err.Number = 0 Then
              For Each v2 In v1
                  arr(i, 2) = arr(i, 2) & ";" & v2
              Next v2
              arr(i, 2) = Mid$(arr(i, 2), 2)
           End If
        On Error GoTo 0
    Next i
    .Value = arr
  End With
End Sub