Ampliar macro eliminar palabras

Hola Bacter
Hace muy poco me has respondido perfectamente a un problema que tenia para reemplazar mediante macro una palabra por otra. Me has mandado una macro que funciona a la perfección y que me sustituye correctamente la palabra "sueño" por "real" en la hoja en que me halle. Cerré la pregunta y te puntué como siempre con Excelente que es lo que te mereces por perder tu tiempo con mis dudas así que de nuevo gracias por todo.
Ahora mi duda es cómo podría ampliar la macro para que además de reemplazarme "sueño" por "real" (que es lo que hace ahora) me reemplazara también "agua" por "tierra" y que hiciera los dos reemplazos en todas las hojas con datos porque con la actual macro solo me reemplaza los datos de la hoja activa y tengo que ir hoja por hoja ejecutando la macro. En mi caso tengo 3 hojas con datos (hoja1, hoja2, hoja3)
La macro que me enviaste que querría ampliar es:
Sub reemplazar_exclusivo()
Dim mirango As Range
Dim celda As Range
Dim busca As String
Dim Remplaza As String
Dim aux1 As String
Dim aux2 As String
Dim resbusc As String
busca = "sueño"
Remplaza = "real"
Range("a1").Select
Set mirango = Range(ActiveCell, ActiveCell.SpecialCells(xlLastCell))
mirango.Select
For Each celda In mirango
    If VarType(celda.Value) = vbString Then
        y = 1
        respbusc = InStr(y, celda.Value, busca, 1)
        If respbusc <> 0 Then
        If Len(celda.Value) = Len(busca) Then
        celda.Value = Remplaza
        Else
        If respbusc = 1 Then
            aux1 = " "
        Else
            aux1 = Mid(celda.Value, respbusc - 1, 1)
        End If
        aux2 = Mid$(celda.Value, respbusc + Len(busca), 1)
        If aux1 = " " And (aux2 = " " Or aux2 = "") Then celda.Value = Replace(celda.Value, busca, Remplaza, 1, 1)
        End If
        End If
    End If
Next
End Sub
Por favor añádeme en esta macro si es posible el reemplazo de "agua" por "tierra" y que los reemplazos no solo se hagan en la hoja activa en que esté sino que al ejecutar la macro me haga los dos reemplazos en todas las hojas del libro, son 3 hojas.
Si puedes en vez de decirme qué lineas debo incluir me podrías enviar de nuevo la macro completa con las líneas añadidas. Soy un poco torpe con las macros.
Gracias por todo

1 respuesta

Respuesta
1
Como estas amigo deprofundis, le agregue un modulo para que funcione de manera general.
Te recomiendo que lo corras paso a paso para que vayas entendiendo como funciona y así modificaciones pequeñas las puedas hacer tu mismo. Igual estamos para ayudarte.
Sub Remplaza_todas_hojas()
Dim ws As Worksheet
Dim a As String
Dim b As String
a = InputBox("Palabra a buscar")
b = InputBox("palabra a reemplazar")
For Each ws In Worksheets
ws.Select
Call reemplazar_exclusivo(a, b)
Next
end sub
Sub reemplazar_exclusivo(busca As String, remplaza As String)
Dim mirango As Range
Dim celda As Range
'Dim busca As String
'Dim remplaza As String
Dim aux1 As String
Dim aux2 As String
Dim resbusc As String
'busca = "sueño"
'remplaza = "real"
Range("a1").Select
Set mirango = Range(ActiveCell, ActiveCell.SpecialCells(xlLastCell))
mirango.Select
For Each celda In mirango
    If VarType(celda.Value) = vbString Then
        y = 1
        respbusc = InStr(y, celda.Value, busca, 1)
        If respbusc <> 0 Then
        If Len(celda.Value) = Len(busca) Then
        celda.Value = remplaza
        Else
        If respbusc = 1 Then
            aux1 = " "
        Else
            aux1 = Mid(celda.Value, respbusc - 1, 1)
        End If
        aux2 = Mid$(celda.Value, respbusc + Len(busca), 1)
        If aux1 = " " And (aux2 = " " Or aux2 = "") Then celda.Value = Replace(celda.Value, busca, remplaza, 1, 1)
        End If
        End If
    End If
Next
End Sub
Saldos
Bacter

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas