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 !
Existe un complemento para excel que hace exactamente esto, se llama rdbmerge, es gratis:
1 respuesta más de otro experto
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