Macro para buscar, copiar y pegar
Necesito una macro urgentemente y no la consigo grabar, tengo una base de datos en la hoja1 de A2:A800 cada celda con un número distinto, en la hoja 2 tengo una base de datos más extensa de 2500 filas y 10 columnas necesito que dicha macro busque el número de la celda A2 en la columna J de la hoja 2 y al encontrarlo copiar la fila en la hoja 3 en la celda A1 y así sucesivamente con cada una de las celdas de la hoja.
2 Respuestas
Te anexo la macro.
Realiza lo siguiente:
1. Supongo que en la hoja2 en la fila 1 tienes encabezados.
2. Entonces copia el encabezado de la hoja2, celda J1 y lo pegas en la hoja1 celda A1
Es decir, el título en ambas hojas debe ser igual, por ejemplo:
De esa forma podemos tener una macro que aplique un filtro avanzado y copie los registros en la hoja3.
Cambia en la macro "hoja1", "hoja2", "hoja3" por los nombres de tus hojas.
Sub Buscar_Copiar_Pegar()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
'
h3.Cells.Clear
uf1 = h1.Range("A" & Rows.Count).End(xlUp).Row
uf2 = h2.Range("J" & Rows.Count).End(xlUp).Row
uc2 = h2.Cells(1, Columns.Count).End(xlToLeft).Column
h2.Range("A1", h2.Cells(uf2, uc2)).AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=h1.Range("A1:A" & uf1), _
CopyToRange:=h3.Range("A1"), Unique:=False
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Hola..¡ Muchísimas gracias por tu respuesta, ya la corrí pero se copian todos los datos de la hoja 2 a la 3, es decir no busca los datos de las celdas de la hoja 1, ¿podría enviarte mi archivo a un mail y así tal vez sea más fácil para usted?
Envíame tu archivo y mee explicas con un ejemplo qué datos de la hoja2 quieres copiar a la hoja3
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Fernando Heras Ortega”
Prueba con esta macro
Sub compara()
Set h2 = Worksheets("hoja2")
Set h3 = Worksheets("hoja3")
Set datos = Range("a2").CurrentRegion
Set datos2 = h2.Range("a2").CurrentRegion
With datos2
.Sort key1:=h2.Range(.Columns(.Columns.Count).Address), order1:=xlAscending
End With
With datos
X = 1
For i = 1 To .Rows.Count
celda = .Cells(i, 1)
cuenta = WorksheetFunction.CountIf(datos2.Columns(datos2.Columns.Count), celda)
If cuenta = 0 Then GoTo siguiente:
fila = WorksheetFunction.Match(celda, datos2.Columns(datos2.Columns.Count), 0)
Set reg = datos2.Rows(fila).Resize(cuenta, datos2.Columns.Count)
If i = 1 Then Set datos3 = h3.Range("a1").Resize(cuenta, datos2.Columns.Count)
If i > 1 Then Set datos3 = datos3.Rows(datos3.Rows.Count + 1).Resize(cuenta, datos3.Columns.Count)
datos3.Value = reg.Value
siguiente:
Next i
End With
End Sub