Macro para realizar concentrado de varios archivos de excel

.24.05.17

Buenas noches, Octavo

A continuación te paso una rutina que deberías agregar a tu archivo que funciona como receptor del rango que le indiques de las hojas en los archivos que tienes en esa carpeta.

En ese archivo operativo, accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo (Insertar -Módulo) y pega el siguiente código:

Sub Consolid()
'---- Variables modificables ----
'=== OCTAVO, modificá estos datos de acuerdo a tu proyecto:
DirBusc = "C:/octavo/proceso/Mayo/archivos" 'carpeta donde están los archivos
Extension = "xls" 'Extensión de los archivos a consolidar. Dejar "*" para que sean todos
TraerHoja = "Hoja 1" 'Hoja de donde tomar los datos de cada archivo
ElRango = "A2:B2" ' Podria usarse en caso de que el rango fuese siempre el mismo.En esta versión no está activo.
JuntarEn = "consolidado" 'Hoja de destino.
CeldaDest = "B10" 'primera celda donde copiar lo que trae del primer archivo
Limpiar = "SI" ' SI para vacíar la hoja consolidado o NO para que agregue a lo existente.
'---- fin Variables
'
' VBA coding by FeJoAl
'
'---- inicio de rutina:
'  
Sheets(JuntarEn).Select
If Limpiar = "SI" Then Cells.Clear
DirBusc = DirBusc & IIf(Right(DirBusc, 1) = "\", "", "\")
Set ArchConsol = ActiveWorkbook
LosArchivos = Dir(DirBusc & "*." & Extension)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While LosArchivos <> ""
    Donde = Application.WorksheetFunction.CountA(ArchConsol.Sheets(JuntarEn).Cells)
    Donde = IIf(Donde > 0, Cells(Sheets(JuntarEn).UsedRange.Row + Sheets(JuntarEn).UsedRange.Rows.Count + 1, Sheets(JuntarEn).UsedRange.Column).Address, CeldaDest)
    Workbooks.Open DirBusc & LosArchivos, xlNo
    Sheets(TraerHoja).Visible = True
    Sheets(TraerHoja).UsedRange.Copy
    ArchConsol.Sheets(JuntarEn).Range(Donde).PasteSpecial Paste:=xlPasteValues
    ArchConsol.Sheets(JuntarEn).Range(Donde).PasteSpecial Paste:=xlPasteFormats
    ArchConsol.Sheets(JuntarEn).Range(Donde).End(xlToRight).Offset(0, 1).Value = LosArchivos
    Workbooks(LosArchivos).Close xlNo
    cont = cont + 1
    LosArchivos = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
    ElMensaje = IIf(cont = 0, "NO SE AGREGO DATOS DE NINGUN ARCHIVO", "Se agregaron DATOS de : " & cont & " archivo" & IIf(cont > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
Set ArchConsol = Nothing
Application.StatusBar = False
End Sub

Nota que al principio del código le podrás indicar de qué carpeta leer los archivos y cual es la extensión que deseas considerar.

También están indicadas la hoja de destino y la de origen de cada archivo (no importa si estuviere oculta o no) y de ella traerá todo lo que tuviere.

A falta de aclaración dejé una última variable que si dejas en SI, borrará todo lo que tiene la hoja de consolidación para empezar de nuevo. Si colocas NO, dejará los datos que tuviese al ejecutar la rutina.

El procedimiento se encarga de agregar a la hoja consolidación el contenido del rango de la hoja indicada de cada archivo que abra -como valores y con el formato original- así como el nombre del archivo a la derecha del último dato traido. Luego cierra el archivo que abrió, sin cambios, para pasar al siguiente.

Pruebalo con tu caso real -y, si te sirviera, agradeceré que califiques mi contribución- o escribeme de nuevo aquí, si necesitas más apoyo con esto.

Un abrazo

Fernando

.

Hola,

Entiendo que eres nuevo por aquí.
Una vez que recibiste la respuesta deberías asignarle una valorización con el botón de opciones (Excelente, Util, Etc) que está al pie, para que quede finalizada. En caso de que tuvieras alguna duda, pregúntame de nuevo.

Cordialmente,
Fer

.

.

. ----- Te quedó pendiente valorizar el tiempo que te dediqué ----