por Hola a todos!, qué tal estáis?, espero que bien.
Hace unos días recibí una consulta en uno de los post publicados en Excel Signum sobre la consolidación de archivos, (AGRUPAR INFORMACIÓN DE VARIOS LIBROS EN UNA HOJA EXCEL). Esto es lo que me preguntaban:
«me parece muy buena la macro y la explicación paso por paso muy profesional, aunque quisiera saber si es posible que se copie la información, no en una misma hoja, sino que cada archivo de excel que copie lo haga en una hoja distinta con el nombre del archivo correspondiente. Muchas gracias!«
La pregunta está bastante clara, en lugar de consolidar o agrupar toda la información de varios archivos en una hoja, lo que se necesita es agrupar toda la información en varias hojas de un archivo, y cada hoja con el nombre del archivo seleccionado. Obviamente si el archivo que se selecciona tiene tres pestañas u hojas, toda esa información se agrupará en la hoja correspondiente de nuestro archivo «agrupador».
Para realizar la tarea, he decidido utilizar la macro del post anterior y adaptarla a las nuevas necesidades.
Option Explicit
Sub AGRUPAR_ARCHIVOS()
'Definimos variables
Dim i As Long, j As Long, FilaInicio As Long, s As Long
Dim nueva As Long, nHojas As Long, fin As Long
Dim iArchivo As String, nArchivo As String, MiLibro As String
Dim dir_Archivo As Variant
Dim iRango As Range, dRango As Range
Dim Hoja_Destino As Worksheet, iLibro As Workbook
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Creamos ventana de diálogo para seleccionar los archivos que queremos agrupar
dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS PARA CONSOLIDAR", MultiSelect:=True, filefilter:="Excel files (*.xls*), *.xls*")
'Si no seleccionamos archivos, salimos del proceso
If Not IsArray(dir_Archivo) Then
Exit Sub
End If
'Iniciamos un for con para identificar los archivos seleccionados
If IsArray(dir_Archivo) Then
For j = LBound(dir_Archivo) To UBound(dir_Archivo)
nArchivo = dir_Archivo(j)
'Añadimos cuantas hojas necesitamos (además de la inicial)
nHojas = ThisWorkbook.Sheets.Count
If nHojas <= UBound(dir_Archivo) Then
nArch = UBound(dir_Archivo) - nHojas + 1
ThisWorkbook.Sheets.Add After:=Sheets("CONSOLIDAR"), Count:=nArch
End If
'nombramos las hojas con el nombre de los archivos.
For s = LBound(dir_Archivo) To UBound(dir_Archivo)
Sheets(s + 1).Name = Dir(dir_Archivo(s))
Next s
'Determinamos a partir de que fila vamos a consolidar los datos
FilaInicio = 2
'Desactivamos actualizacion de pantalla y eventos
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Identificamos el nombre de nuestro libro
MiLibro = ThisWorkbook.Name
'Indicamos la hoja de destino de los datos que queremos consolidar
Set Hoja_Destino = ThisWorkbook.Sheets(Dir(nArchivo))
'Listamos los archivos Excel a consolidar
iArchivo = nArchivo
'Si la longitud del archivo es cero, salimos del proceso (no existe archivo para consolidar)
If Len(iArchivo) = 0 Then Exit Sub
'Si el nombre del archivo no es igual a nuestro libro seguimos el proceso
If Not iArchivo = MiLibro Then
'Capturamos ruta al iarchivo
Set iLibro = Workbooks.Open(Filename:=nArchivo)
'Contamos las hojas que tiene
fin = iLibro.Sheets.Count
For i = 1 To fin
iLibro.Sheets(i).Select
'Copiamos cada hoja del archivo seleccionado
Set iRango = iLibro.Sheets(i).Range(Cells(FilaInicio, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set dRango = Hoja_Destino.Range("A" & Hoja_Destino.Cells(Rows.Count, 1).End(xlUp).Row)
iRango.Copy
'Pegamos la información en la hoja destino.
With dRango
.PasteSpecial xlPasteValues
.PasteSpecial xlFormats
End With
Next
'Cerramos el libro y continuamos el proceso
Application.CutCopyMode = False
iLibro.Close False
End If
Next j
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
' Una vez finalizado, lanzamos mensaje de finalización.
MsgBox ("EL PROCESO HA FINALIZADO CORRECTAMENTE"), vbInformation, "PROCESO DE CONSOLIDACIÓN"
End Sub
En este caso, la he programado para que consolide únicamente los datos sin tener en cuenta los encabezados. Si los queréis tener en cuenta tendréis que modificar lo siguiente:
Set dRango = Hoja_Destino.Range("A" & Hoja_Destino.Cells(Rows.Count, 1).End(xlUp).Row)
FilaInicio = 2Por esto:
Set dRango = Hoja_Destino.Range("A" & Hoja_Destino.Cells(Rows.Count, 1).End(xlUp).Row + 1)
FilaInicio = 1 Vamos a utilizar un ejemplo muy sencillo. Imaginad que tenemos 3 archivos con los empleados de 3 centros de trabajo:
y cada archivo tiene a su vez tres pestañas con 20 empleados cada una, es decir, 60 empleados cada archivo.
Una vez ejecutado el código de nuestra macro este será el resultado:
Como podemos ver, ya tenemos agrupados por pestañas todos los archivos que hemos seleccionado.
Si no queréis ver la extensión en los archivos «.xls», tendréis que modificar la macro en dos líneas:
Sheets(s + 1).Name = Dir(dir_Archivo(s))
Set Hoja_Destino = ThisWorkbook.Sheets(Dir(nArchivo))Por estas:
Sheets(s + 1).Name = split(Dir(dir_Archivo(s)),".")(0)
Set Hoja_Destino = ThisWorkbook.Sheets(split(Dir(nArchivo),".")(0))Y esto es todo por hoy. Espero que os sea de utilidad!
Descarga el archivo de ejemplo pulsando en:
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.
¡¡Muchas gracias!!
Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies
