copiar rango variable de varios libros en uno solo
publicado
Buenos tardes, gusto en saludarles, les escribo para ver si me pueden ayudar con una duda que tengo con una macro, tengo que copiar de varios archivos que se encuentran en un misma carpeta y cuyos nombres varían solamente es la fecha por ejemplo “Reporte Diario_02052017”, es decir lo único que cambia son los últimos 8 caracteres del nombre de estos archivos, de los mimos deseo copiar determinados rangos de datos que se encuentran en varias columnas, las columnas siempre serán las mismas (B14, F14, H14, I14, K14, L14 Y M14) hasta la última fila con valor, luego esos rangos los debe pegar en determinadas columnas en el archivo "BD INFORME MENSUAL DE VaR.xls" en la hoja "BASE DE DATOS". les explico lo que hice y en donde están mis dudas, adapte la siguiente sintaxis que encontré, pero solo copiando el rango K14:M14 hasta la última fila con valor solo para ver si realiza el proceso, al correr la macro solo me está tomando los datos de un solo archivo en la carpeta, la del último día registrado (18052017), no me está copiando el del resto de los archivos dentro de la carpeta, que es lo que quiero, que de todos los archivos dentro de la carpeta copie el mismo rango de valores y los pegue en el archivo BD INFORME MENSUAL DE VaR.xls. Mi otra duda está en cómo debo hacer para que el rango B14 hasta la última fila con valor lo pegue en la columna A en la última fila disponible del archivo BD INFORME MENSUAL DE VaR.xls, el rango F14, H14, I14 hasta la última fila con valor lo pegue a partir de la columna D en la última fila disponible y el rango K14, L14 Y M14 hasta la última fila con valor lo pegue en la columna G en la última fila disponible. Esperando me puedan ayudar con la siguiente duda, quedo a la espera de su siempre oportuna recomendación.
Saludos cordiales
Sub UnirDatosVersion2()
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xls*")
Set h1 = ThisWorkbook.Sheets("BASE DE DATOS")
nFilaFin = Range("a" & Rows.Count).End(xlUp).Row
On Error Resume Next
ffin = h1.UsedRange.Find(what:="*").Row
ActiveCell.SpecialCells(xlLastCell).Select
On Error Resume Next
Do While archi <> ""
If InStr(1, archi, "BD INFORME MENSUAL DE VaR") = 0 Then
Workbooks.Open archi
If Err.Number = 0 Then
Sheets(1).Select
Range("K14:M14", Range("K14:M14").End(xlDown)).Copy _
h1.Range("G" & nFilaFin + 1)
End If
Err.Number = 0
Application.DisplayAlerts = False
Workbooks(archi).Close
Application.DisplayAlerts = True
End If
archi = Dir()
Loop
End Sub
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buenos tardes, gusto en saludarles, les escribo para ver si me pueden ayudar con una duda que tengo con una macro, tengo que copiar de varios archivos que se encuentran en un misma carpeta y cuyos nombres varían solamente es la fecha por ejemplo “Reporte Diario_02052017”, es decir lo único que cambia son los últimos 8 caracteres del nombre de estos archivos, de los mimos deseo copiar determinados rangos de datos que se encuentran en varias columnas, las columnas siempre serán las mismas (B14, F14, H14, I14, K14, L14 Y M14) hasta la última fila con valor, luego esos rangos los debe pegar en determinadas columnas en el archivo "BD INFORME MENSUAL DE VaR.xls" en la hoja "BASE DE DATOS". les explico lo que hice y en donde están mis dudas, adapte la siguiente sintaxis que encontré, pero solo copiando el rango K14:M14 hasta la última fila con valor solo para ver si realiza el proceso, al correr la macro solo me está tomando los datos de un solo archivo en la carpeta, la del último día registrado (18052017), no me está copiando el del resto de los archivos dentro de la carpeta, que es lo que quiero, que de todos los archivos dentro de la carpeta copie el mismo rango de valores y los pegue en el archivo BD INFORME MENSUAL DE VaR.xls. Mi otra duda está en cómo debo hacer para que el rango B14 hasta la última fila con valor lo pegue en la columna A en la última fila disponible del archivo BD INFORME MENSUAL DE VaR.xls, el rango F14, H14, I14 hasta la última fila con valor lo pegue a partir de la columna D en la última fila disponible y el rango K14, L14 Y M14 hasta la última fila con valor lo pegue en la columna G en la última fila disponible. Esperando me puedan ayudar con la siguiente duda, quedo a la espera de su siempre oportuna recomendación.
Saludos cordiales
Sub UnirDatosVersion2() Application.ScreenUpdating = False ruta = ThisWorkbook.Path ChDir ruta archi = Dir("*.xls*") Set h1 = ThisWorkbook.Sheets("BASE DE DATOS") nFilaFin = Range("a" & Rows.Count).End(xlUp).Row On Error Resume Next ffin = h1.UsedRange.Find(what:="*").Row ActiveCell.SpecialCells(xlLastCell).Select On Error Resume Next Do While archi <> "" If InStr(1, archi, "BD INFORME MENSUAL DE VaR") = 0 Then Workbooks.Open archi If Err.Number = 0 Then Sheets(1).Select Range("K14:M14", Range("K14:M14").End(xlDown)).Copy _ h1.Range("G" & nFilaFin + 1) End If Err.Number = 0 Application.DisplayAlerts = False Workbooks(archi).Close Application.DisplayAlerts = True End If archi = Dir() Loop End Sub