Macro para buscar dato en hojas definidas y copia las columnas de la fila coincidente
amig@s expert@s. Tengo un libro con seis hojas: "data1", "data2", "data3", "data4", "data5", "buscarCASO". En la hoja "buscarCASO", tengo un botón que llama a un inputbox, donde se coloca el número de caso a buscar. La búsqueda sólo la hace en "data1" y me devuelve toda las coincidencias que encuentre y las copia en la misma hoja "buscarCASO" a partir de la fila que he determinado y solo de las columnas que necesito. La macro funciona muy bien, pero solo hace la búsqueda en "data1". Si ese mismo número de caso también esta en "data3" y "data5" y quiero agregar al informe de búsqueda también los resultados de "data3" y "data5" y solo algunas columnas adicionales, ¿cómo haría?.
Dejo el código de la macro que funciona solo en una hoja, que encontré aquí en todoexpertos y adapte a mi necesidad. Inteligencia colectiva dicen!
Sub BuscarCASO()
'por Luis Mangelo
fila = 8
dato = InputBox("INGRESE N° DE CASO", "BUSCAR CASO")
If dato = False Then Exit Sub
Set busca = Sheets("hoja1").Range("B2:B" & Sheets("hoja1").Range("B65000").End(xlUp).Row).Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Do
Sheets("Buscar_Caso").Cells(fila, 2).Value = busca
Sheets("Buscar_Caso").Cells(fila, 3).Value = busca.Offset(0, 8)
Sheets("Buscar_Caso").Cells(fila, 4).Value = busca.Offset(0, 9)
Sheets("Buscar_Caso").Cells(fila, 5).Value = busca.Offset(0, 10)
Sheets("Buscar_Caso").Cells(fila, 6).Value = busca.Offset(0, 17)
Sheets("Buscar_Caso").Cells(fila, 7).Value = busca.Offset(0, 18)
fila = fila + 1
Set busca = Sheets("hoja1").Range("B2:B" & Sheets("hoja1").Range("B65000").End(xlUp).Row).FindNext(busca)
Loop While Not busca Is Nothing And busca.Address <> ubica
End If
End Sub
Gracias Adriel. Esta parte del codigo me va bien para que busque en todas las hojas el valor de la celda E3:
Sub buscar()
p = False
Set h1 = Sheets("Hoja1")
'
If h1.[E3] = "" Then
MsgBox "Ingrese un nombre a buscar"
h1.[E3].Select
Exit Sub
End If
'
For Each h In ThisWorkbook.Sheets
If h.Name <> "Hoja1" Then
h.Select
Set b = h.Range("B7:F38").Find(h1.[E3], Lookat:=xlPart)
If Not b Is Nothing Then
p = True¿Pero como hago para que me copie las coincidencias y las columnas que deseo?. Según el código que he usado esta parte lo haría:
Do
Sheets("Buscar_Caso").Cells(fila, 2).Value = busca
Sheets("Buscar_Caso").Cells(fila, 3).Value = busca.Offset(0, 8)
Sheets("Buscar_Caso").Cells(fila, 4).Value = busca.Offset(0, 9)
Sheets("Buscar_Caso").Cells(fila, 5).Value = busca.Offset(0, 10)
Sheets("Buscar_Caso").Cells(fila, 6).Value = busca.Offset(0, 17)
Sheets("Buscar_Caso").Cells(fila, 7).Value = busca.Offset(0, 18)
fila = fila + 1¿Se puede usar también después de <p = true>?. y hay que recordar que la misma fila con el dato buscado esta en mas de una hoja. Resultado de la búsqueda muestra todas las coincidencias y copia las columnas que quiero
Hoja donde ha sido realizada la búsqueda
A veces en las demás hojas esta el mismo numero de caso, pero varia los valores de la tercera o cuarta columna del resultado y también los quiero mostrar, porque cada hoja es de un departamento diferente. Por eso quiero que busque en todas las hojas o solo en la data1 data3 o data5 como mejor se pueda hacer.No se si me explico.
Gracias por toda la ayuda que puedas brindarme.
Valora la respuesta para finalizar
Prueba la siguiente macro
Sub buscar()
p = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Buscar_Caso")
'
If h1.[E3] = "" Then
MsgBox "Ingrese un nombre a buscar"
h1.[E3].Select
Exit Sub
End If
'
fila = 8
'
For Each h In ThisWorkbook.Sheets
If h.Name <> "Hoja1" Then
h.Select
Set r = h.Columns("B:B")
Set b = r.Find(Val(h1.[E3]), Lookat:=xlPart)
If Not b Is Nothing Then
p = True
ubica = b.Address
Do
h2.Cells(fila, 2).Value = b
h2.Cells(fila, 3).Value = b.Offset(0, 8)
h2.Cells(fila, 4).Value = b.Offset(0, 9)
h2.Cells(fila, 5).Value = b.Offset(0, 10)
h2.Cells(fila, 6).Value = b.Offset(0, 17)
h2.Cells(fila, 7).Value = b.Offset(0, 18)
fila = fila + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ubica
End If
Next h
h2.Select
If p = False Then MsgBox "el nombre no existe"
MsgBox "fin"
End Sub
