Para hacer eso puedes utilizar el siguiente código que me encontré (yo lo he probado y funciona perfectamente):
Sub MultiReemplazo()
Dim ColOne() As String, ColTwo() As String
Dim rngRange1 As Range, rngRange2 As Range
Dim intResponse As Integer
Dim intLookAt As Integer
Dim iCols As Long
Dim iRows As Long
Dim i As Long
On Error Resume Next
intResponse = MsgBox("Dando 2 Columnas de la Tabla" & vbCrLf & "Esta macro reemplazará un rango del usuario", vbExclamation + vbOKCancel, "Reemplazar")
If intResponse = vbOK Then
Set rngRange1 = Application.InputBox("Seleccione dos Columnas de la Tabla y el texto de reemplazo", "Multi-Reemplazo", ActiveCell.CurrentRegion.Address, , , , , 8)
If rngRange1 Is Nothing Then Exit Sub
' MsgBox rngRange1.Address
DoEvents
Set rngRange2 = Application.InputBox("Selecione el rango para reemplazar.", "Multi-Reemplazo", , , , , , 8)
If rngRange2 Is Nothing Then Exit Sub
' MsgBox rngRange2.Address
iCols = rngRange1.Columns.Count
iRows = rngRange1.Rows.Count
If rngRange1.Columns.Count > 2 Or rngRange1.Columns.Count < 2 Then
MsgBox "You must select a two-column range of cells", vbCritical + vbOKOnly
Exit Sub
End If
On Error GoTo errorhandler
ReDim ColOne(1 To iRows)
ReDim ColTwo(1 To iRows)
For i = 1 To iRows
ColOne(i) = rngRange1.Cells(i, 1)
ColTwo(i) = rngRange1.Cells(i, 2)
Next i
If Err <> 0 Then
MsgBox Err.Number & " :" & Err.Description
On Error GoTo 0
Exit Sub
End If
DoOver:
intLookAt = Application.InputBox("Digite 1 para coincidencia exacta , 2 para Parcial", "Multi-Reemplazo", 1, , , , , 1)
Select Case intLookAt
Case 1
'do nothing
Case 2
'do nothing
Case Else
MsgBox "Por favor digite 1 o 2"
GoTo DoOver
End Select
intResponse = MsgBox("Continuar(Si) o Retroceder(No)", vbQuestion + vbYesNoCancel, "Multi-Reemplazo")
If intResponse = vbCancel Then Exit Sub
If intResponse = vbYes Then
On Error GoTo errorhandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To iRows
rngRange2.Replace What:=ColOne(i), Replacement:=ColTwo(i), LookAt:=intLookAt, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End If
If intResponse = vbNo Then
For i = 1 To iRows
rngRange2.Replace What:=ColTwo(i), Replacement:=ColOne(i), LookAt:=intLookAt, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next i
End If
End If
Application.ScreenUpdating = True
MsgBox "Selección Reemplazada"
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
Exit Sub
errorhandler:
MsgBox "Error: " & Err.Number & " (" & Err.Description & ")"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
On Error GoTo 0
End Sub
Los pasos a seguir son, primero seleccionas tus dos columnas, segundo seleccionas la columna que vas a sustituir y tercero sigues los pasos indicados y listo.
[email protected]