try

Sub test()
Dim r As Range, SearchStr As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("sheet1"): Set ws2 = Sheets("sheet2")
For Each r In ws1.Range("a1", ws1.Range("a65536").End(xlUp))
Set SearchStr = ws2.Columns(1).Find(what:=r.Value)
If Not SearchStr Is Nothing Then
With SearchStr
.Offset(, 2) = .Offset(, 2) - r.Offset(, 2)
With .Offset(, 4)
If IsEmpty(.Value) Then
.Value = ws1.Range("d1").Text
Else
.Value = .Value & "; " & ws1.Range("d1").Text
End If
End With
End With
End If
Next