Macro para filtrar datos de una hoja a otra ya sea por folio de ingreso o por una palabra?
Que tal buen día quisiera que me puedan ayudar con una macro. Que se pueda filtrar y visualizar datos al escribir en una celda el folio o el numero de compra, que vaya a buscar en otra hoja del mismo libro que se tendrá una base de datos y me visualice los datos en varias celdas, encontré un código pero no me sirvió de mucho.
Sub buscar()
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 Sub
1 Respuesta
Respuesta de Dante Amor
1
Te comento que en la hoja destino tienes celdas combinadas, entonces la macro considera esas celdas, para escribir en la celdas combinadas y en las celdas que no lo están.
También esta macro tiene la opción de desproteger la hoja, cambia en la macro "abc" por el password que desees para desproteger y proteger la hoja.
Sub TraerDatos2()
'Por.Dante Amor
Set h1 = Sheets("Hoja4")
Set h2 = Sheets("Respaldo1")
h1.Unprotect "abc"
'
i = 10
Do While Cells(i, "B") <> "" Or Cells(i + 1, "B") <> ""
i = i + 2
Loop
'
Set b = h2.Columns("B").Find(h1.[T3], lookat:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
h1.Cells(i, "B") = h2.Cells(b.Row, "C") 'Orden de compra
h1.Cells(i, "C") = h2.Cells(b.Row, "D") 'Cons
h1.Cells(i, "D") = h2.Cells(b.Row, "E") 'Rda
h1.Cells(i, "E") = h2.Cells(b.Row, "F") 'Ent
h1.Cells(i + 1, "I") = h2.Cells(b.Row, "G") 'cantidad
'h1.Cells(i+1, "J") = h2.Cells(b.Row, "C") 'unidad
h1.Cells(i + 1, "L") = h2.Cells(b.Row, "H") 'Fecha
h1.Cells(i + 1, "N") = h2.Cells(b.Row, "I") 'Precio
h1.Cells(i, "P") = h2.Cells(b.Row, "J") 'Factura
h1.Cells(i, "Q") = h2.Cells(b.Row, "K") 'Lote
Else
MsgBox "Número de folio no existe", vbExclamation
End If
h1.Protect "abc"
End Sub
