Macro para filtrar datos de una Hoja a otra
Tengo aquí una macro que aporto un usuario en donde se puede filtrar datos de una hoja a otra y colocar los resultados en esta ultima. Ahora bien mi problema esta en que esta macro filtra todas las filas hacia el costado y yo necesito que solo filtre 4 filas hacia el costado porque toda la demás información no me interesa.
Dejo aquí la macro.
Gracias
Sub buscafilas()
'Por.dam
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h1.Select
ufila = ActiveCell.SpecialCells(xlLastCell).Row
ucol = ActiveCell.SpecialCells(xlLastCell).Column
h1.Range(Cells(2, 1), Cells(ufila, ucol)).Clear
datobuscar = h1.Range("A1")
h2.Select
ufila = ActiveCell.SpecialCells(xlLastCell).Row
ucol = ActiveCell.SpecialCells(xlLastCell).Column
With h2.Range(Cells(1, 1), Cells(ufila, ucol))
Set datoEncontrado = .Find(datobuscar)
If Not datoEncontrado Is Nothing Then
filaDato1 = datoEncontrado.Row
Do
filadato = datoEncontrado.Row
h2.Rows(filadato).EntireRow.Copy _
h1.Range("A" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1)
proxima:
Set datoEncontrado = .FindNext(datoEncontrado) 'Busca el siguiente dato
If datoEncontrado.Row = filadato Then filadato = filadato + 1: GoTo proxima:
Loop While Not datoEncontrado Is Nothing And datoEncontrado.Row <> filaDato1
End If
End With
End Sub
2 Respuestas
Da la sensación, Jonatan, que donde has escrito filas quisiste escribir columnas.
Para entender mejor tu necesidad, te sugiero que subas en algún servidor gratuito una versión pequeña de tu archivo. Aprovecha para escribir en la segunda hoja que es lo que deseas obtener y -a mano- pon el resultado esperado: ¿De acuerdo?...
Apenas reconocí esa macro, bueno además de que dice Por.dam y por el set h1. Nunca me gusto eso de datobuscar y datoencontrado. Pero ahora ya tengo mi propia versión, disculpa el comentario.
Bueno, te anexo la nueva versión para buscar con el ciclo: do - loop while, creo que esta macro ya es más clara.
Sub buscar()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h1.Range(h1.[A2], h1.[A2].SpecialCells(xlLastCell)).Clear
'
Set b = h2.Cells.Find(h1.[A1], lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
h2.Range("A" & b.Row & ",C" & b.Row & ",E" & b.Row & ",G" & b.Row).Copy _
h1.Range("A" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1)
Set b = h2.Cells.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End SubCambia en la macro en esta línea la "A", la "C", la "E" y la "G" por las 4 columnas que quieres.
h2.Range("A" & b.Row & ",C" & b.Row & ",E" & b.Row & ",G" & b.Row).Copy _Saludos.DAM
Recuerda valorar la respuesta.
Esta buena la macro, funciona a la perfección. Pero me queda una ultima cosa ja ja, yo tengo los datos que quiero filtrar en la columna B de la hoja2 por ejemplo un Código, Supongamos que el código es 1275 si yo ingreso 1275 me busca todo lo que contenga 1275 dentro de la hoja2, pero lo que yo quiero es que me busque todos los 1275 pero solo dentro la de columna B y de ahí si me filtre hacia el costado las 4 columnas con sus respectivos datos.
Esto no lo entiendo: "y de ahí si me filtre hacia el costado las 4 columnas", te refieres a que te traiga las columnas B, C, D, ¿E y F?
Si es correcto lo anterior, esta es la macro buscar dentro de la columna B y poner las columnas de la B a la F
Sub buscar()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h1.Range(h1.[A2], h1.[A2].SpecialCells(xlLastCell)).Clear
'
Set b = h2.Columns("B").Find(h1.[A1], lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
h2.Range("B" & b.Row & ":F" & b.Row).Copy _
h1.Range("A" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1)
Set b = h2.Cells.FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End SubRecuerda valorar la respuesta
Perdona, me faltó un cambio, utiliza esta
Sub buscar()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h1.Range(h1.[A2], h1.[A2].SpecialCells(xlLastCell)).Clear
'
Set b = h2.Columns("B").Find(h1.[A1], lookat:=xlPart)
If Not b Is Nothing Then
ncell = b.Address
Do
h2.Range("B" & b.Row & ":F" & b.Row).Copy _
h1.Range("A" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1)
Set b = h2.Columns("B").FindNext(b)
Loop While Not b Is Nothing And b.Address <> ncell
End If
End Sub
¡Gracias! Funciona a la perfección.
Dante Volviendo a Molestar jaja! Una ultima consulta: Mi problema esta en que la macro no filtra un dato especifico, es decir si yo ingreso por ejemplo el numero 250 para que busque dentro la columna B de la Hoja 2 este me filtra todo lo que contenga 250 dentro la columna B por ejemplo 1250 2250 y así... pero yo solo quiero que me filtre 250 únicamente, que el valor del filtro sea exactamente igual al valor ingresado.
Muchas Gracias!
Cambia en la macro esta línea
Set b = h2.Columns("B").Find(h1.[A1], lookat:=xlPart)Por esta
Set b = h2.Columns("B").Find(h1.[A1], lookat:=xlWhole)