Find String and Replace With Adjacent Cell

Steve,

Give this a try:

Sub tgr()
    
    Dim rngReplace As Range
    Dim rngFound As Range
    Dim arrReplace As Variant
    Dim ReplaceIndex As Long
    
    Set rngReplace = Sheets(1).Range("A1", Sheets(1).Cells(Rows.Count, "A").End(xlUp))
    arrReplace = rngReplace.Value2
    
    With Sheets(2).Columns("B")
        For ReplaceIndex = 1 To UBound(arrReplace, 1)
            .NumberFormat = "General"
            Set rngFound = .Find(arrReplace(ReplaceIndex, 1), .Cells(.Cells.Count), xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                arrReplace(ReplaceIndex, 1) = rngFound.Offset(, 1).Text
                Set rngFound = Nothing
            End If
        Next ReplaceIndex
    End With
    
    rngReplace.Value = arrReplace
    
    Erase arrReplace
    Set rngReplace = Nothing
    
End Sub