Copiar el mismo rango de diferentes hojas de varios archivos a un nuevo archivo excel

Quisiera saber como puedo copiar en un libro en blanco o en el libro donde esta mi macro, un mismo rango de diferentes archivos.

Ejemplo: rango ("a2:d3"); .. La hoja en todos los archivos se llama correspondencia, los archivos están guardados en una misma carpeta(facturas),, pero dentro de la carpeta puede cambiar el numero de archivos.

Quiero colocar los rangos obtenidos de los diferentes archivos, uno sobre otro dejando una fila de por medio.. Esta operación se puede realizar a partir de la fila 2 con el fin de colocar mis encabezados manuakmente.

1 respuesta

Respuesta
3

Te anexo la macro

Sub ActualizarLibro()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets.Add
    nom = l1.Name
    ruta = l1.Path & "\"
    ChDir ruta
    archi = Dir("*.xls*")
    '
    Do While archi <> ""
        If archi <> l1.Name Then
            Set l2 = Workbooks.Open(archi)
            'Rows(1).Copy h1.[A1]
            u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 2
            Range([a2], [a2].SpecialCells(11)).Copy h1.Range("A" & u)
            l2.Close False
            archi = Dir()
        End If
    Loop
    Application.ScreenUpdating = True
    MsgBox "libros copiados", vbInformation
End Sub

Pon la macro en el archivo nuevo y guardar el archivo en la misma carpeta donde tienes los demás archivos.

Saludos. Dante Amor

Buen día Dante:

Gracias por tu colaboración, efectivamente la macro funciona copiando todo el contenido de los demás archivos, pero por ahora lo que necesito es que copie el mismo rango de todos los archivos. Este rango esta en todos los archivos en una hoja con el mismo nombre

Ejemplo Rango (a2:d3") (de todos los archivos), la hoja se llama igual en todos los archivos (Correspondencia)

Un saludo

Tienes razón, pediste un rango, te cambio la macro:

Sub ActualizarLibro()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets.Add
    nom = l1.Name
    ruta = l1.Path & "\"
    ChDir ruta
    archi = Dir("*.xls*")
    '
    Do While archi <> ""
        If archi <> l1.Name Then
            Set l2 = Workbooks.Open(archi)
            'Rows(1).Copy h1.[A1]
            u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 2
            Range("a2:d3").Copy h1.Range("A" & u)
            l2.Close False
            archi = Dir()
        End If
    Loop
    Application.ScreenUpdating = True
    MsgBox "libros copiados", vbInformation
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Gracias Dante,

La macro toma el rango pero de todas las hojas de los libros, quisiera que tomara el rango pero unicamente de la hoja "facturacion" la cual esta en todos los archivos con el mismo nombre.

Mil gracias

Disculpa nuevamente, la macro copia el rango, no de todas las hojas, solamente de la hoja activa, pero puede ser que la hoja activa no sea la de "facturacion", pero ya actualicé esa parte, prueba con esta macro:

Sub ActualizarLibro()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets.Add
    nom = l1.Name
    ruta = l1.Path & "\"
    ChDir ruta
    archi = Dir("*.xls*")
    '
    Do While archi <> ""
        If archi <> l1.Name Then
            Set l2 = Workbooks.Open(archi)
            'on error resume next
            u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 2
            Sheets("facturacion").Range("a2:d3").Copy h1.Range("A" & u)
            On Error GoTo 0
            l2.Close False
            archi = Dir()
        End If
    Loop
    Application.ScreenUpdating = True
    MsgBox "libros copiados", vbInformation
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas