Copiar datos de un rango de una hoja,en especial de varios libros excel, ubicados todos en una misma carpeta, a un nuevo libro.

H o la: En la siguiente macro actualiza estos datos:

    Set h1 = l1.Sheets("Hoja1")     'hoja destino
    col = "A"                       'columna destino
    rango = "B3:D5"                 'rango a extraer
    num = "Hoja1"                   'hoja origen, nombre de la hoja especial

Pon la macro en un libro nuevo y la ejecutas. La macro te pedirá que selecciones la carpeta donde tienes los libros; la macro copiará el rango y lo pegará en la columna "A", siempre abajo del rango anterior pegado.

Sub Copiar_Un_Rango()
'---
'   Por.Dante Amor
'---
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")     'hoja destino
    col = "A"                       'columna destino
    rango = "B3:D5"                 'rango a extraer
    num = "Hoja1"                   'hoja origen, nombre de la hoja especial
    '
    Ruta = l1.Path & "\"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = Ruta
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1)
    End With
    '
    arch = Dir(cp & "\" & "*.xls*")
    Do While arch <> ""
        Set l2 = Workbooks.Open(cp & "\" & arch)
        Set h2 = l2.Sheets(num)
        u = h1.Range(col & Rows.Count).End(xlUp).Row + 1
        h2.Range(rango).Copy
        h1.Cells(u, col).PasteSpecial xlValues
        h1.Cells(u, col).PasteSpecial xlFormats
        l2.Close False
        arch = Dir()
    Loop
    MsgBox "Fin"
End Sub

Al finalizar, tendrás en el nuevo libro todos los rangos.

Prueba y me comentas.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

¡Gracias! 

Mi estimado, si me sirvió el archivo adjunto, me preguntaba si de alguna manera, luego de seleccionar el rango de datos que empieza o no, en la columna "A" y termina dependiendo el rango, se puede colocar en la siguiente columna el nombre del archivo del cual se sustrajo los datos, y así sucesivamente.

Gracias de antemano y disculpa la molestia..!

R ecuerda valorar la respuesta, ya que la macro realiza lo que solicitaste, lo de agregare el nombre es algo adicional; y con todo gusto realizo el cambio.

¡Gracias!

Pregunta dada por exitosa..! Me sirvió mucho.

Saludos y éxitos en todo.

Te anexo la macro actualizada para poner el nombre del libro

Sub Copiar_Un_Rango()
'---
'   Por.Dante Amor
'---
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")     'hoja destino
    col = "A"                       'columna destino
    rango = "A3:D7"                 'rango a extraer
    num = "Hoja1"                   'hoja origen, nombre de la hoja especial
    '
    ruta = l1.Path & "\"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = ruta
        If .Show <> -1 Then Exit Sub
        cp = .SelectedItems(1)
    End With
    '
    arch = Dir(cp & "\" & "*.xls*")
    Set r = Range(rango)
    ncol = r.Columns.Count
    nrow = r.Rows.Count - 1
    Do While arch <> ""
        Set l2 = Workbooks.Open(cp & "\" & arch)
        Set h2 = l2.Sheets(1)
        u = h1.Range(col & Rows.Count).End(xlUp).Row + 1
        h2.Range(rango).Copy
        h1.Cells(u, col).PasteSpecial xlValues
        h1.Cells(u, col).PasteSpecial xlFormats
        h1.Range(h1.Cells(u, Columns(col).Column + ncol), _
            h1.Cells(u + nrow, Columns(col).Column + ncol)) = l2.Name
        l2.Close False
        arch = Dir()
    Loop
    MsgBox "Fin"
End Sub

sal u dos

Disculpando que sean tan molesto yo!, ocurre que inserte la macros pero al momento de hacerla correr, para obtener los resultados de los rangos de varios archivos en una carpeta seleccionada.

Solo al final me apareció el nombre del ultimo archivo de la carpeta, digo esto porque al retirar dicho archivo de la carpeta y volverla a correr me volvió a aparecer el nombre del ultimo archivo, que anteriormente era penúltimo.

espero me puedas ayudar..

Gracias y Saludos..!

¿Cambiaste algo en la macro?

¿Tus archivos tienen datos en el rango que vas a copiar?

¿Cuántos archivos tiene tu carpeta?

La macro solamente te va a poner el nombre del archivo de lo que estás ejecutando, si tienes información anterior, esa información no se actualiza.

Si quieres borra toda tu información de la hoja, pon todos tus archivos en la carpeta y ejecuta la nueva versión de la macro.

Si no es eso, no estoy entendiendo qué necesitas.

Hola.!

Nuevamente molestando, con mis preguntas.

1.- Ya hice eso que mencionas líneas arriba, mis celdas si tienen datos en ese rango.

2.- La carpeta seleccionada tiene 25 archivos y se puede extender a más...

3.- Dejo un ejemplo de como me gustaría el resultado

La Columna A y B es mi rango (ejemplo)

La columna C es el nombre del archivo al cual se le extrajo el rango

4.- Pero al correr la macro solo me da el nombre del ultimo archivo contenido en la carpeta, Ejemplo para este seria

Columna C, archivo 13

Saludos..