VBA para concatenar datos otro archivo excel si cumplen cierta condición
Solicito muy cordialmente que me colaboren con una macro para extraer o concatenar información de otro libro excel si se cumple una condición indicada.
Tengo el archivo donde quiero insertar la VBA que seria esta imagen:
y el archivo de donde quiero extraer los datos es este:
En la primer imagen en la celda A6 esta el numero 1, esta esta contando los números que hay en la imagen #2 en el rando de A6:J6, en la celda A7 de la primer imagen tenemos en numero 4, que esta contando los números que hay en la imagen #2 en el rango de A7:J7, y así sucesivamente hacia abajo.
El archivo de la segunda imagen tiene el nombre de "100xlsm"
Básicamente lo que necesito es una macro que me extraiga los números que están en el rango de la segunda imagen. Pero solo si el numero de la primera imagen esta por debajo de 6. Osea que con este ejemplo solo extraería los datos de la filas 6,7,12,13 ya que las otras filas tienen cantidad de 6 números o superior.
Osea quedando como resultado de la ejecución de la macro así:
Como pueden observar la macro extrajo las filas del archivo 100.xlsm, pero solo las filas que contenían cantidad de números inferiores a 6. En este caso la macro empezó a pegar los resultados en la columna C de este archivo, pero la idea es que después yo le pueda modificar a la macro donde puede empezar a pegar los resultados ya que puede variar la columna donde pega los resultados.
Espero me puedan ayudar, de verdad para mi es muy básico hacer una macro desde cero..
Mil gracias y de antemano les agradezco sus respuestas que siempre son de mucha ayuda... Feliz tarde..
Entendiendo que los datos tanto de libro 1 como del libro2 coinciden en el mismo numero de fila te dejo el siguiente código, tomando en consideración que no proporcionas ruta, te dejo para que se pueda elegir el archivo2.
Sub Actualiza()
Dim UltFila As Integer
Dim Baseactual, Baseexterna As String
Application.ScreenUpdating = False
UltFila = Range("A" & Rows.Count).End(xlUp).Row
Baseactual = ActiveWorkbook.Name
documento = Application.GetOpenFilename
If documento <> False Then
Workbooks.Open documento
Baseexterna = ActiveWorkbook.Name
Workbooks(Baseactual).Activate
For I = 3 To UltFila
If Cells(I, 1).Value <> "" Then
If Cells(I, 1).Value < 6 Then
Workbooks(Baseexterna).Activate
Workbooks(Baseexterna).Sheets("DATOS").Range("C" & I & ":L" & I).Copy
Workbooks(Baseactual).Activate
Workbooks(Baseactual).Sheets("DATOS").Range("C" & I).PasteSpecial
If I = UltFila Then
Workbooks(Baseexterna).Activate
ActiveWindow.Close False
MsgBox "PROCESO TERMINADO"
End If
End If
End If
Next I
End If
Application.ScreenUpdating = True
End SubVerificarlo y me comentas.
Mauro mil gracias por tomarte el tiempo de ayudarme.
Te cuento que mi conocimiento es muy bajo en macros, no entiendo donde corregir el archivo 2 (me imagino que hay que colocar la ruta) lo digo como para que me ubiques donde debo corregirlo, el archivo esta en una carpeta en el escritorio que se llama "prueba" y ambos archivos están en la misma ruta o carpeta.el archivo de donde debe extraer lleva el nombre de "100.xlsm"
Ambos archivos coinciden con la misma fila pero solo en el ejemplo, voy adecuarlo a otros libros donde no van a extraer en la misma fila y tampoco van a pegar en la misma fila. Ni van a coincidir en la columna "A", los dos archivos.. si se puede variar esos datos me quedaría excelente para adecuarlo a los otros libros.
Por ultimo te cuento que probé la macro, pero cuando doy ejecutar, abre una ventana donde me pide que abra el archivo "me imagino que es el archivo de donde tiene que extraer los datos"lo busco y le doy abrir, autmaticamente me aparece un error de ejecución 9 y se para el proceso en este punto:
Espero ser lo más claro posible para así agilizar tu respuesta
Mil gracias mauro
Te explico el código:
Sub Actualiza()
Se declaran las variables
Dim UltFila As Integer
Dim Baseactual, Baseexterna As String
**Evita que se vea el proceso al correr la macro
Application.ScreenUpdating = False
**determina la ultima fila del libro1
UltFila = Range("A" & Rows.Count).End(xlUp).Row
**detrmina el nombre del libro1
Baseactual = ActiveWorkbook.Name
**Abre cuadro de dialogo para buscar otro archivo
documento = Application.GetOpenFilename
If documento <> False Then
**Abre el archivo2
Workbooks.Open documento
**Determina el nombre del Archivo2
Baseexterna = ActiveWorkbook.Name
**Activa el Archivo1
Workbooks(Baseactual).Activate
**Genera un blucle que determina las filas que son menores a 6
For I = 3 To UltFila
**Si son menores a 6
If Cells(I, 1).Value <> "" Then
If Cells(I, 1).Value < 6 Then
**Activa el Archivo2
Workbooks(Baseexterna).Activate
******Copia el rango de la columna C a la D de la fila del libro que es menor a 6
Workbooks(Baseexterna).Sheets("DATOS").Range("C" & I & ":L" & I).Copy
**Activa el Archivo1
Workbooks(Baseactual).Activate
**Activa el pega los datos en el archivo1
Workbooks(Baseactual).Sheets("DATOS").Range("C" & I).PasteSpecial
**Determina si llego al Final de los datos del libro1 y cirerra el libro2
If I = UltFila Then
Workbooks(Baseexterna).Activate
ActiveWindow.Close False
MsgBox "PROCESO TERMINADO"
End If
End If
End If
Next I
End If
Application.ScreenUpdating = True
End SubEl error te lo manda al copiar el rango del libro 2 asegúrate que los rangos no estén protegidos este lo determine de la columna C a la L o que tengan celdas combinadas.
Mauro definitivamente me sigue apareciendo le mismo error, no deben estar bloqueadas pues el archivo es nuevo, y tampoco tiene celdas combinadas.
No se si se pueda enviar el archivo ya que no encontré manera de hacerlo envío foto para que visualices ya que en alguna parte no veo el error..
Mi version es la 2007
Mil gracias
Si envíamelo [email protected]
¡Gracias! Mauro al parecer era el pc porque cambie a otro equipo y sirvió de maravilla... bendiciones
Que bien, Saludos.
Sol te pido
Cualquier cosas aquí nos encostramos.
