Macro para Unir varios archivos excel

H o la: envíame 3 archivos de excel. Los archivos 1 y 2 que sean dos de los archivos que se tienen que unir. En el archivo 3 me pones cómo uniste esos 2 archivos.

Supongo que los archivos a unir están todos en la misma carpeta.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Yuri Corro” y el título de esta pregunta.

Hola buenos Dias,

Te he enviado la información que me pediste. 

Gracias de antemano por responder.

Saludos

H   o l a: Te anexo la macro

Sub Unir_Archivos()
'---
'   Por.Dante Amor
'---
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    h1.Range("A2:I" & h1.Rows.Count).Clear
    nom = l1.Name
    ruta = l1.Path & "\"
    fila = 2
    '
    arch = Dir(ruta & "*.xls*")
    Do While arch <> ""
        dato = Left(arch, InStrRev(arch, ".") - 1)
        If arch <> nom Then
            Set l2 = Workbooks.Open(ruta & arch)
            Set h2 = l2.Sheets(2)
            u2 = h2.Range("B" & h2.Rows.Count).End(xlUp).Row
            h2.Range("B2:I" & u2).Copy h1.Range("A" & fila)
            u1 = h1.Range("B" & h2.Rows.Count).End(xlUp).Row
            h1.Range(h1.Cells(fila, "I"), h1.Cells(u1, "I")) = dato
            fila = u1 + 1
            l2.Close False
        End If
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Archivos unidos", vbInformation, "UNIR ARCHIVO"
End Sub

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

Amigo, ¿la parte que esta comentada la dejo así?, me da error en la definición de las variables, he declarado las variables tipo Object, pero me sigue apareciendo error en la línea:

 nom = l1.Name

¿Probaste con el archivo que te envié?

Sí, deja la parte comentada.

Te anexo la macro con las variables declaradas

Sub Unir_Archivos()
'---
'   Por.Dante Amor
'---
    Dim l1, h1, nom, ruta, fila, arch, dato, l2, h2, u2, u1
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    h1.Range("A2:I" & h1.Rows.Count).Clear
    nom = l1.Name
    ruta = l1.Path & "\"
    fila = 2
    '
    arch = Dir(ruta & "*.xls*")
    Do While arch <> ""
        dato = Left(arch, InStrRev(arch, ".") - 1)
        If arch <> nom Then
            Set l2 = Workbooks.Open(ruta & arch)
            Set h2 = l2.Sheets(2)
            u2 = h2.Range("B" & h2.Rows.Count).End(xlUp).Row
            h2.Range("B2:I" & u2).Copy h1.Range("A" & fila)
            u1 = h1.Range("B" & h2.Rows.Count).End(xlUp).Row
            h1.Range(h1.Cells(fila, "I"), h1.Cells(u1, "I")) = dato
            fila = u1 + 1
            l2.Close False
        End If
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Archivos unidos", vbInformation, "UNIR ARCHIVO"
End Sub

Si te aparece un error, dime qué dice el mensaje y en qué línea de la macro se detiene.

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

Me da error en la línea: SUBÍNDICE FUERA DE INTERVALO

Set h2 = l2.Sheets(2)

Eso significa que el libro que vas a unir no tiene 2 hojas, en los ejemplos que me enviaste, los 2 libros tenían 2 hojas. Entonces los libros que no tienen 2 hojas deberías retirarlos de la carpeta.

O si hay libros con 2 hojas y libros con una hoja, y si tiene una hoja, que consolide la hoja1 y si tiene 2 hojas que consolide la hoja2, ¿o cómo hacemos?

¡Gracias! 

Ahora funciona, muchísimas gracias por tomarte tiempo en ayudarme...

Saludos Cordiales