Combinar varios libros Excel en uno en hojas separadas

06/10/16

Buenas tardes, Oscar

A continuación te paso una rutina que deberías agregar a un archivo auxiliar que funcionará como receptor de las hojas delos archivos que, idealmente, tendrás en una carpeta.

Al final del proceso, podrás eliminar la hoja original y guardarlo con otro nombre.

En ese nuevo archivo operativo, accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo - si no tuvieras uno ya- y pega el siguiente código:

Sub juntator()
'---- Variables modificables:
'=== OSCAR, modifica estos datos de acuerdo a tu proyecto:
DirBusc = "C:\CARPETAdeARCHIVOS"
Extension = "xlsx"
'---- fin Variables
'
'---- inicio de rutina:  
Set Consolidado = ActiveWorkbook
DirBusc = DirBusc & IIf(Right(DirBusc, 1) = "\", "", "\")
LosArchivos = Dir(DirBusc & "*." & Extension)
Application.DisplayAlerts = False
Do While LosArchivos <> ""
Workbooks.Open DirBusc & LosArchivos, xlNo
ActiveSheet.Copy After:=Consolidado.Sheets(Consolidado.Sheets.Count)
NomHoja = Left(LosArchivos, InStr(1, LosArchivos, Extension) - 2)
ActiveSheet.Name = Trim(Left(LosArchivos, WorksheetFunction.Min(21, InStr(1, LosArchivos, Extension) - 2)))
Workbooks(LosArchivos).Close xlNo
cont = cont + 1
LosArchivos = Dir
Loop
Application.DisplayAlerts = True
    ElMensaje = IIf(cont = 0, "NO SE AGREGO HOJA ALGUNA", "Se agregaron las hojas 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
End Sub
Set Consolidado = Nothing
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. Si quisieras que traiga todos los archivos de MS Excel, reemplazala la variable "xlsx" por "xls*"

La rutina se encarga de agregar la hoja activa de cada archivo que abra a este consolidador, coloca el nombre del archivo en la pestaña y cierra el que abrió, sin cambios, para pasar al siguiente.

.

.

Buenas de nuevo,

Mientras esperaba tus comentarios, se me ocurrieron un par de mejoras al anterior:

1. Reduce el tiempo de ejecución, indicando -al pié- de qué archivo está trayendo la hoja
2. Permite tomar los datos de carpeta y extensión de un par de celdas en la hoja de donde se lanza el proceso, en lugar de escribirlo dentro del código. Algo así como esto:

   

Si te interesa, toma esta variante de aquel código:

Sub juntator()
'---- inicio de rutina:  
DirBusc = "B2"
Extension = "B3"  
DirBusc = ActiveSheet.Range(DirBusc)
DirBusc = DirBusc & IIf(Right(DirBusc, 1) = "\", "", "\")
Extension = ActiveSheet.Range(Extension)
Set Consolidado = ActiveWorkbook
LosArchivos = Dir(DirBusc & "*." & Extension)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While LosArchivos <> ""
Application.StatusBar = ">>>>>>>>>>>>>> Un momento, egragando hoja de archivo " & Left(LosArchivos, InStr(1, LosArchivos, Extension) - 2)
Workbooks.Open DirBusc & LosArchivos, xlNo
ActiveSheet.Copy After:=Consolidado.Sheets(Consolidado.Sheets.Count)
NomHoja = Left(LosArchivos, InStr(1, LosArchivos, Extension) - 2)
ActiveSheet.Name = Trim(Left(LosArchivos, WorksheetFunction.Min(21, InStr(1, LosArchivos, Extension) - 2)))
Workbooks(LosArchivos).Close xlNo
cont = cont + 1
LosArchivos = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
    ElMensaje = IIf(cont = 0, "NO SE AGREGO HOJA ALGUNA", "Se agregaron las hojas 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 Consolidado = Nothing
Application.StatusBar = False
End Sub

Espero que te sirva.

Abrazo

Fer

.

Hola Fer:

No se si lo estoy haciendo bien. Abro un excel nuevo en el directorio donde tengo los archivos que quiero juntar, el editor, inserto un modulo, copio el texto. Cierro el editor. En Macros aparece la tuya "juntator" y al darla ejecutar me dice que no se agrego ninguna hoja. No se si tengo que guardar el excel con la extension xlsm e intentar ejecutar desde ahí, pero lo he probado y no funciona tampoco. ¿Que hago mal? Explícamelo como si fuera "tonto" a ver si me entero, te doy mi permiso.

.

Buenos días, Oscar

Por lo que mencionas, hiciste todo bien. Lo que no comentas es si cambiaste la dirección de la carpeta donde están los archivos y la extensión de los archivos a traer. En la segunda variante puedes hacerlo desde las celdas indicadas en el ejemplo.

Por otra parte, una vez que hayas seguido los pasos de creación del archivo de la macro y lo grabes te servirá para todas las veces que quieras usarlo. Es decir, no es necesario repetir esos pasos cada vez que quieras combinar los archivos.

Entonces, si no lo hiciste antes, asegurate de escribir la dirección completa y correcta donde están los archivos, luego ejecuta la macro y coméntame si anduvo.

Abrazo

Fer

.

Si hubieses tenido la oportunidad de probar la solución, espero que te haya ayudado a resolver tu problema.

Si así fuera, agradeceré un comentario y que la valorices para finalizarla.

Hola. Perdona la tardanza en contestar. Funcionó bien. Gracias por todo.