Buscar si dato existe en todas las hojas. Copiar en otra hoja las filas donde el dato se encuentre

Te mando mi solución con esta macro y estas son las instrucciones:

-Tenemos una hoja llamada "resultados" que estará vacía en la que se pegarán todas las búsquedas.

-Tenemos una hoja llamada "datos" y anotaremos en la columna A desde A1 hacia abajo las palabras que queremos buscar.

-En el resto de hojas están los datos.

Ahora solo queda ejecutar esta macro:

Sub ejemplo()
'por luismondelo
fila = 1
Sheets("datos").Select
Range("a1").Select
Do While ActiveCell.Value <> ""
valor = ActiveCell.Value
For Each hoja In ActiveWorkbook.Sheets
If UCase(hoja.Name) <> "RESULTADOS" And UCase(hoja.Name) <> "DATOS" Then
hoja.Select
For Each celda In ActiveSheet.UsedRange
If UCase(celda.Value) = UCase(valor) And InStr(lista, celda.Row) = 0 Then
celda.EntireRow.Copy
Sheets("resultados").Cells(fila, 1).PasteSpecial Paste:=xlValues
lista = lista & celda.Row
fila = fila + 1
End If
Next
End If
lista = ""
fila = fila + 1
Next
Sheets("datos").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub

recuerda finalizar la consulta

Muchas gracias Experto.

Se puede modificar para que los resultados se pongan en filas contiguas? Es decir, que no el primer resultado esté en la primer fila y el siguiente en la 50 (por poner un ejemplo) y todas las filas de en medio estén vacías.

Por otro lado, sabes si es normal que la macro se trabe? Excel deja de responder después de unos 15 segundos aproximadamente. Tuve que reducir la cantidad de datos a 3 para que lograra generar los resultados antes de dejar de responder. Mi total de datos son 400 :)

Muchas gracias!

Entonces prueba ahora con esta y tendrás los resultados juntos

Sub ejemplo()
'por luismondelo
Sheets("datos").Select
Range("a1").Select
Do While ActiveCell.Value <> ""
valor = ActiveCell.Value
For Each hoja In ActiveWorkbook.Sheets
If UCase(hoja.Name) <> "RESULTADOS" And UCase(hoja.Name) <> "DATOS" Then
hoja.Select
For Each celda In ActiveSheet.UsedRange
If UCase(celda.Value) = UCase(valor) And InStr(lista, celda.Row) = 0 Then
celda.EntireRow.Copy
Sheets("resultados").range("a65000").end(xlup).offset(1,0).PasteSpecial Paste:=xlValues
lista = lista & celda.Row
End If
Next
End If
lista = ""
Next
Sheets("datos").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub

recuerda finalizar