Try:
Sub ReplaceCell()
Application.ScreenUpdating = False
Dim WIP As Range, srcWS As Worksheet, desWS As Worksheet, fnd As Range
Set desWS = Sheets("Output")
Set srcWS = Sheets("Data")
With desWS
For Each WIP In .Range("C2", .Range("C" & .Rows.Count).End(xlUp))
If WIP Like "*/Britpart" Then
Set fnd = srcWS.Range("C:C").Find(Split(WIP, "/")(0), LookIn:=xlValues, lookat:=xlWhole)
If Not fnd Is Nothing Then
WIP = fnd.Offset(, 3)
End If
End If
Next WIP
End With
Application.ScreenUpdating = True
End Sub
Bookmarks