Saltar al contenido

copiar rango variable de varios libros en uno solo


sadeliano

Recommended Posts

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

 

  • Silvia bloqueó este tema

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.