¿Como abrir varios archivos en una ruta con una macro?
Tengo la siguiente necesidad. Quisiera Abrir 4 archivos que están en una ruta, estos archivos se descargan de un aplicativo y siempre se llaman diferente, ya que queda el nombre con la fecha de descarga. Todos tienen la misma estructura, y quisiera que la macro fuera a la ruta abriera cada uno de los archivos (sin importar el nombre) y los consolidara en una sola hoja.
1 Respuesta
[Hola
Prueba así:
Dim fso As Object, folder As Object
Dim File As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("D:\Programas\")
For Each File In folder.Files
Workbooks.Open (File)
'aquí todo lo que quieras hacer
Next FileLo de consolidar es cuestión de copiar/pega (en donde dejé el comentario).
Comentas]
Abraham Valencia
Hola Abraham
Primero quiero agradecerte por tu ayuda. Este código funciona a la perfección, de hecho lo complemente con otra código que me ayudaste a resolver y es la selección de un rango.
Pero quisiera preguntar, yo requiero abrir los archivos que están en una carpeta, copiar y pegar la información, y me gustaría luego cerrar el archivo que se abrió. ¿como podría hacerlo?
Te comparto mi código final
Sub Abrirarchivos()
Principal = ActiveWindow.Caption
Dim ultimaFila As Long
Dim rango As Long
Dim fso As Object, folder As Object
Dim File As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("D:\Ruben - Documentos\Macros, Sas y Power BI\Macro Tiempo de Repuesta\Archivos")
For Each File In folder.Files
Workbooks.Open (File)
'aquí todo lo que quieras hacer
Sheets(1).Select
Let rango = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:AN" & rango).Copy
Workbooks(Principal).Activate
ultimaFila = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Cells(ultimaFila + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Next File
End Sub
[Hola
Prueba así:
Sub Abrirarchivos()
Dim ultimaFila As Long, rango As Long
Dim Principal As String
Dim fso As Object, folder As Object
Dim File As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Principal = ActiveWindow.Caption
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("D:\Ruben - Documentos\Macros, Sas y Power BI\Macro Tiempo de Repuesta\Archivos")
For Each File In folder.Files
Workbooks.Open (File)
Let rango = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Sheets(1).Range("A2:AN" & rango).Copy
ultimaFila = Workbooks(Principal).Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Workbooks(Principal).Cells(ultimaFila + 1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
ActiveWorkbook.Close
Next File
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubAdáptalo porque, por obvias razones, yo no puedo probarla, pero ahí está la idea.
Abraham Valencia
Hola Abraham, ¿cómo estas?
Me esta presentado dos situaciones, la primera es que me esta saliendo un error, al ejecutar la línea
Workbooks(Principal).Cells(ultimaFila + 1, 1).PasteSpecial Paste:=xlValues
el error es el siguiente:
La sguda situación se presenta en la línea al momento de cerrar el libro (ActiveWorkbook.Close), ya que esta cerrando el libro principal (donde estoy consolidado la información) el que requiero cerrar es el libro que fui a buscar en la ruta, se abre para copiar los datos.
Mil gracias por tu ayuda, y que pena la molestia
[Hola
Como comenté, no podía probarlo ya que lo lo hice desde el celular. Faltaba la hoja:
Workbooks(Principal). Sheets(1).Cells(ultimaFila + 1, 1). PasteSpecial Paste:=xlValues
Ojo que estoy asumiendo que es en la primera hoja en la que quieres los datos, y no es la única línea de código en la cual asumo eso. Por eso te decía que lo trates de adapta y para ello debes entender cada línea.
Sobre el otro error, sugiero cambiar todos los "ActiveWorkBook" por WorkBooks(file. Name)
Abraham Valencia
