Macro excel que liste un directorio y abra uno a uno los archivos en el

La idea, es poder tener un "recopilador" de datos que compile o agrupe la info de distintos archivos (numero variable, no siempre serán los mismo o con el mismo nombre, es pro eso el problema).

La idea es que ejecute lo siguiente:

- Que el archivo "recopilador" abra el archivo 1 (ejm), copie lo que hay en sus hojas (siempre tendrán todos la misma cantidad de hojas, aunque en algún momento una de ellas pueda estar vacía pero con los títulos) y lo pegue en el archivo recopilador, cerrando archivo 1 sin guardar los cambios.

Esto lo debe ejecutar por cada uno de los archivos que se encuentran en el directorio que, como dije anteriormente, el nombre puede ser variable al igual que la cantidad de archivos.

1 Respuesta

Respuesta
3

Te acerco una macro para esto... quizás necesita aún algún ajuste.

Lo que hace es presentarte el explorador para que ubiques la carpeta que necesitas capturar. Luego abre cada libro Excel pasando cada una de sus hojas tengan o no datos, en hojas nuevas del recopilador.

Sub RECOPILANDO()
'x Elsamatilde
'se abre el cuadro de diálogo para elegir la carpeta donde estarán los libros
Set Direc = Application.FileDialog(msoFileDialogFolderPicker)
If Direc.Show = 0 Then
    Ruta = ""
    Exit Sub
End If
Ruta = Direc.SelectedItems(1)
destino = ActiveWorkbook.Name
'Se agrega una hoja a libro recopilador
Workbooks(destino).Sheets.Add After:=Sheets(Sheets.Count)
'evita el movimiento de libros/hojas
Application.ScreenUpdating = False
'se crea la referencia al objeto Filesystem
With CreateObject("scripting.filesystemobject")
    With .GetFolder(Ruta)
    'se recorre el conjunto de archivos Excel de la carpeta elegida
    For Each Archi In .Files
        If InStr(1, Archi.Type, "Excel") Then
            'abre libro y agrega cada hoja al libro Recopilador
            Workbooks.Open (Archi)
            origen = ActiveWorkbook.Name
            For i = 1 To Sheets.Count
                ActiveWorkbook.Sheets(i).Select
                Cells. Copy
                Workbooks(destino).Activate
                ActiveWorkbook.Sheets(Sheets.Count).Select
                ActiveSheet.Paste
                'se agrega otra hoja al libro recopilador
                Workbooks(destino).Sheets.Add After:=Workbooks(destino).Sheets(Sheets.Count)
                Workbooks(origen).Activate
            Next i
            'se cierra el libro capturado omitiendo posibles avisos
            Application.DisplayAlerts = False
            ActiveWorkbook.Close False
        End If
    Next
    End With
End With
MsgBox "Fin de la recopilación"
End Sub

Probala y si esto resuelve tu consulta no olvides valorarla (Excelente o Buena) ... sino comenta y la seguimos tratando.

Hola! Muchas gracias y cumple con una parte de lo que necesito. Si bien abre todos los archivos y copia las hojas y las envia al archivo recopilador... Lo hace por hojas separadas, es decir, no me llena una hoja con toda la información, si no que me genera 90 hojas distintas.

La idea es que tome el archivo, lo abra, copie el contenido de la hoja1 y vaya a la primera celda disponible de la hoja1 (mismo nombre en todos los archivos) de la columna A y pegue el contenido y que haga lo mismo con la hoja2. Después, que abra el siguiente archivo y repita el proceso, llenando una base de datos en la misma hoja1 y hoja2 correspondiente.

Como no habías comentado nada acerca de como ubicar las hojas hice lo habitual ;)

Ahora falta que confirmes entonces otros detalles:

1- ¿Solo son 2 hojas por libro?

2- Todas las hojas 1 de csda libro van agregadas en la hoja 1 del recopilador; ¿Y las hojas 2 en otra y así con todas?

3- ¿Los títulos solo van en la primer copia y el resto se agrega sin separar?

Sdos!

Mi error, sorry!!

En cuanto a tus preguntas:

1. Si, efectivamente son 2 hojas por libro, y se llaman igual en cada libro (todos los libros tienen igual nombre de hojas al igual que el recopilador).

2. Exacto. La hoja1 de cada libro se agrega en la hoja1 del recopilador, y la hoja2 de cada libro en la de igual nombre en el recopilador.

3. Si. Los titulos los tiene el libro (y hojas) del recopilador, por lo cual el ideal sería que copie solo los datos de las hojas de los distintos archivos y los pegue en el recopilador. Tener en consideración que todos los archivos tienen titulo n sus hojas.

Muchas gracias!

Adjunto nueva macro.

- Estoy considerando que solo hay 1 fila de títulos por hoja, es decir que estando los títulos en fila 1 los datos empiezan en fila 2.

- Estoy considerando que la col A tiene datos hasta el final de rango, sino ajustarla por la col de mayor información allí donde empieza con 'ini =

Sub RECOPILANDO()
'x Elsamatilde
'se abre el cuadro de diálogo para elegir la carpeta donde estarán los libros
Set Direc = Application.FileDialog(msoFileDialogFolderPicker)
If Direc.Show = 0 Then
    Ruta = ""
    Exit Sub
End If
Ruta = Direc.SelectedItems(1)
destino = ActiveWorkbook.Name
'evita el movimiento de libros/hojas
Application.ScreenUpdating = False
'se crea la referencia al objeto Filesystem
With CreateObject("scripting.filesystemobject")
    With .GetFolder(Ruta)
    'se recorre el conjunto de archivos Excel de la carpeta elegida
    For Each Archi In .Files
        If InStr(1, Archi.Type, "Excel") Then
            'abre libro y agrega cada hoja al libro Recopilador
            Workbooks.Open (Archi)
            origen = ActiveWorkbook.Name
            For I = 1 To 2
                'guarda la 1er fila libre x hoja destino ... tomando la col A (verificar)
                ini = Workbooks(destino).Sheets(I).Range("A" & Rows.Count).End(xlUp).Row + 1
                ActiveWorkbook.Sheets(I).Select
                'se copia el rango utilizado pegandolo en hoja destino a partir de la 1er fila libre
                ActiveSheet.UsedRange.Copy Destination:=Workbooks(destino).Sheets(I).Range("A" & ini)
                'se borra la fila de título
                Workbooks(destino).Sheets(I).Range("A" & ini).EntireRow.Delete
            Next I
            'se cierra el libro capturado omitiendo posibles avisos
            Application.DisplayAlerts = False
            ActiveWorkbook.Close False
        End If
    Next
    End With
End With
MsgBox "Fin de la recopilación"
End Sub

No olvides valorar la respuesta (Excelente o buena) para darla por finalizada. Si necesitas algún otro detalle por favor inicia una nueva consulta que esta ya lleva 2 macros desarrolladas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas