VBA para copiar ciertos datos a otro libro
Mi necesidad es la siguiente, tengo un libro con varios datos (Libro1.xlsm), de este libro quiero copiar ciertos datos a otro libro (Libro2.xlsm). Pondré un ejemplo de las condiciones que se deben cumplir:
- En “Libro1.xlsm”, hoja “Acumulados”, buscar en la columna “D” las todas las filas que contengan el dato “Y1809” (que es el año 2018 y la semana 09).
- Si se encuentran los datos anteriores, ahora buscar en la columna “E” las filas que contengan el dato “HGST” (son proveedores).
- Teniendo estos datos filtrados, ahora copiarlos y pegarlos al “Libro2.xlsm”, Hoja “Fallas”, en la última fila de los datos ya existentes.
La idea es hacerlo con VBA para que sea automático, los datos que quiero que busque no necesito meterlos por casillas, estos los ingresare con otra parte del código que ya tengo.
2 respuestas
Te anexo la macro, pero faltaron algunos datos en tu ejemplo.
- En el libro1, hoja "acumulados", no mencionas si tienes encabezado y en cuál fila empiezan tus datos. Voy a suponer que tienes el encabezado en la fila 1 y los datos empiezan en la fila 2.
- ¿Quieres copiar toda la fila o solamente algunas columnas? De igual forma voy a suponer que toda la fila.
Si es como supongo ejecuta la siguiente macro.
Sub Macro6()
' Por Dante Amor
' Copia registros a libro2
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Acumulados")
Set l2 = Workbooks("libro2.xlsm")
Set h2 = l2.Sheets("fallas")
'
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("A1:E" & u1).AutoFilter Field:=4, Criteria1:="Y1809"
h1.Range("A1:E" & u1).AutoFilter Field:=5, Criteria1:="HGST"
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
u2 = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Rows("2:" & u1).Copy
h2.Range("A" & u2).PasteSpecial xlValues
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Registros copiados"
End SubPuedes asignar a un botón la macro y ejecutarla cuando lo necesites.
Tampoco entendí esta parte:
"los datos que quiero que busque no necesito meterlos por casillas, estos los ingresare con otra parte del código que ya tengo."
En mi código puedes ver en qué línea va el filtrado.
Hola Dante, exactamente eso es lo que necesitaba!! Le atinaste a todo los puntos que no aclare. Antes de cerrar el tema pudieras aclararme una duda y si no es mucho pedir agregar algunos detalles al código. Primero tuve dudas de donde debería de insertar el código, por fin deduje que iba en el "Libro2.xlsm", entonces por ende el otro libro debería ser "Libro1.xlsx", pero no me funciono me dio "erro 9". Entonces me di cuenta que ambos archivo tendrían que tener extensión "xlsm" para que funcionara, ¿esto es normal? Aquí van mis peticiones:
1. Que el código se ejecute desde el "Libro1.xlsm".
2. Que "Libro2" tenga extensión "xlsx".
Muchas gracias por tu atención.
La macro va en el libro1.
Puedes cambiar donde dice libro2.xlsm a libro2.xlsx
.
No olvides valorar la respuesta
¡Gracias! Dante.
Hola Dante, regresando nuevamente con el código que me compartiste.
Surgió un imprevisto, cuando se filtra un valor que no se encuentra dentro de los datos, me copia todos valores. Me podrías asesorar para insertar una condicional que termine el proceso si el resultado del filtro esta vació. Saludos.
Prueba con lo siguiente
Sub Macro6()
' Por Dante Amor
' Copia registros a libro2
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Acumulados")
Set l2 = Workbooks("libro2.xlsm")
Set h2 = l2.Sheets("fallas")
'
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("A1:E" & u1).AutoFilter Field:=4, Criteria1:="Y1809"
h1.Range("A1:E" & u1).AutoFilter Field:=5, Criteria1:="HGST"
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
If u1 > 1 Then
u2 = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
h1.Rows("2:" & u1).Copy
h2.Range("A" & u2).PasteSpecial xlValues
End If
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Registros copiados"
End Sub
Es posible que te puede llegar a aportar algo más sobre lo que requieres
https://www.programarexcel.com/2013/05/macro-vba-recorre-filas-busca-y-copia.html