Necesito una Macro para unir 700 archivos Excel

Tengo que unir en una hoja excel las primeras 10 filas de 700 archivos excel, los cuales poseen la información en una hoja llamada "costos". Los datos están dentro de las columnas A y J

Aparte, hay algunos archivos que no poseen la hoja llamada "costos" y tienen otro formato, por el cual habría que omitirlos ( no copiarlos).

Es importante que solo se copien las 10 primeras filas de cada archivo y solo de las hojas llamadas "costos".

También, al abrir y cerrar archivos, que omita cualquier pregunta de guardar, o actualizar, o cualquier otra que entorpezca la macro.

Es urgente, lo necesito para poder realizar mi proyecto de titulo y esto es lo único que me falta. Ayudaaaaa !

2

2 respuestas

Respuesta
1

Te anexo la macro

Sub UnirArchivos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    h1.Cells.Clear
    '
    fila = 1
    ruta = ThisWorkbook.Path & "\"
    arch = Dir(ruta & "*.xlsx")
    Do While arch <> ""
        Set l2 = Workbooks.Open(ruta & arch, ReadOnly:=True)
        For Each h In l2.Sheets
            If LCase(h.Name) = "costos" Then
                h.Range("A1:J10").Copy h1.Cells(fila, "A")
                fila = fila + 10
                Exit For
            End If
        Next
        l2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

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

Hola, gracias por tu respuesta, hice correr la macro pero no funcionó, y creo que es porque falta la parte de pegar las filas seleccionadas de un archivo al archivo base. 

La macro abre todos los archivos, pero igual me pregunta si deseo actualizar los datos, y en eso debo hacerle click a todas para que no se actualicen.

ayudaa!

Esta línea de la macro copia y pega:

h. Range("A1:J10"). Copy h1. Cells(fila, "A")

No entiendo por qué te pegunta "deseo actualizar los datos".

Tienes protegido tu libro, o tu hoja, o tienes algo en la hoja, ¿o modificaste la macro?

Pon la macro en un nuevo libro. En una hoja nueva. Ejecuta la macro.

Si te sigue apareciendo el mensaje, entonces envíame tu archivo base, con la macro y un par de archivos.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Christian Eduardo Corvalan Rodriguez” y el título de esta pregunta.

Si te funciona, no olvides valorar la respuesta.

Amigo, mil gracias esta vez si me funciono, me di cuenta que en el nombre de las hojas habia un espacio al final de "costos ". Ahora si copio y pego todo. Te lo agradezco !

Amigo, falto una cosa no mas, se me copiaron las celdas pero con las formulas, entonces me salen puros #¡Valor!... Necesito que se copien los valores, como lo hago?

Te anexo la macro para copiar valores:.

Sub UnirArchivos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    h1.Cells.Clear
    '
    fila = 1
    ruta = ThisWorkbook.Path & "\"
    arch = Dir(ruta & "*.xlsx")
    Do While arch <> ""
        Set l2 = Workbooks.Open(ruta & arch, ReadOnly:=True)
        For Each h In l2.Sheets
            If LCase(h.Name) = "costos" Then
                h.Range("A1:J10").Copy
                h1.Cells(fila, "A").PasteSpecial xlValues
                fila = fila + 10
                Exit For
            End If
        Next
        l2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub
Respuesta

Existe un complemento para excel que hace exactamente esto, se llama rdbmerge, es gratis:

http://www.rondebruin.nl/win/addins/rdbmerge.htm

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas