Sub Xreplace()
Dim Xkeys As New Scripting.Dictionary
With ThisWorkbook.Sheets("Sheet1")
RR = .Range("a4000").End(xlUp).Row
XData = .Range("A1").Resize(RR, 4)
RX = .Range("G1000").End(xlUp).Row
NewData = .Range("G1").Resize(RX, 2)

For rdx = 2 To UBound(XData)
If Xkeys.Exists(XData(rdx, 1)) = False Then Xkeys.Add XData(rdx, 1), rdx
Next rdx

For rdx = 2 To UBound(NewData)
If Xkeys.Exists(NewData(rdx, 1)) = True Then
idx = Xkeys(NewData(rdx, 1))
XData(idx, 2) = NewData(rdx, 2)
End If
Next rdx
.Activate
.Range("A1").Resize(RR, 2) = XData

End With
End Sub