Correction to the line:
C2.EntireRow.EntireRow.Delete
Should be
C2.EntireRow.Delete

Don't know how that happened ???

Regards,
Greg
-----Original Message-----
Suggested is the following:

Sub TransferAndDelete()
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim C1 As Range, C2 As Range, C3 As Range
Dim FNm As String, LNm As String

With Sheets("Sheet2")
Set Rng1 = .Range("A2:A" & .UsedRange.Rows.Count)
'Next line only necessary if gap in data possible
Set Rng1 = Rng1.SpecialCells(xlCellTypeConstants)
End With
With Sheets("Sheet1")
Set Rng2 = .Range("B2:B" & .UsedRange.Rows.Count)
'Next line only necessary if gap in data possible
Set Rng2 = Rng2.SpecialCells(xlCellTypeConstants)
Set Rng3 = Rng2.Offset(, 1)
End With
For Each C1 In Rng1.Cells
C1 = Trim(C1)
If InStr(2, C1, " ") 0 Then
FNm = Left(C1, InStr(1, C1, " ") - 1)
LNm = Right(C1, Len(C1) - Len(FNm) - 1)
Else
FNm = ""
LNm = ""
End If
For Each C2 In Rng2.Cells
C2 = Trim(C2)
If C2 = LNm Then
Set C3 = C2(1, 2)
If Trim(C3) = FNm Then
C1(1, 2) = C2(1, 0)
C1(1, 3) = C3(1, 2)
C1(1, 4) = C3(1, 3)
C2.EntireRow.EntireRow.Delete
End If
End If
Next
Next
End Sub

Minimal testing done.

Regards,
Greg
(VBA Amateur)

.