Bom dia Carlos, tente usar o código da seguinte forma:

Sub CorrigirNomes()
Dim Palavra1 As String, Palavra2 As String, Celula As Range

Sheets("CADASTRO").Select

For Each Celula In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Palavra1 = Cells(Celula.Row, 2).Value

Palavra2 = Cells(Celula.Row, 3).Value

If Celula Like "*" & Palavra1 & "*" Then
Celula = Replace(Celula, Palavra1, Palavra2)
End If

Next Celula

Sheets("Home").Select

End Sub