Hi,
try the code

Sub test()
Dim r As Range, txt, ws1 As Worksheet, ws2 As Worksheet
Dim LookUpCell As Range, x
Set ws1 = Sheets("sheet1"): Set ws2 = Sheets("sheet2")
With ws2
For Each r In .Range("b1", .Range("b65536").End(xlUp))
If Not IsEmpty(r) Then
If InStr(r, ";") = 0 Then
Set LookUpCell = ws1.Range("a:a").Find(what:=r.Value,
lookat:=xlWhole)
LookUpCell.Offset(, 1) = r.Offset(, -1).Value
Else
txt = Split(Replace(r, " ", ""), ";")
For Each x In txt
Set LookUpCell = ws1.Range("a:a").Find(what:=x,
lookat:=xlWhole)
LookUpCell.Offset(, 1) = r.Offset(, -1).Value
Next
End If
End If
Next
Set ws1 = Nothing: Set ws2 = Nothing: Erase txt
End With