por Hola a todos!.
Espero que las vacaciones hayan ido muy bien. Yo acabo de finalizarlas y ahora toca comenzar de nuevo con las tareas habituales.
El tema de hoy se basa en una consulta remitida por un lector, que solicita una macro que agrupe o recopile la información contenida en una celda específica en distintos archivos y hojas.
Este es un tema recurrente que ya he tratado en varias ocasiones y para distintos escenarios, sin embargo hoy nos centraremos en extraer la información haciendo referencia solo a celdas y no a rangos de información.
La macro que vamos a utilizar es la siguiente:
Sub RECOPILAR_ARCHIVOS()
'Definimos variables
Dim i As Integer, j As Integer, n As Integer
Dim elimina As Long, FilaInicio As Integer, fin As Long
Dim iArchivo As String, nArchivo As String, MiLibro As String
Dim dir_Archivo As Variant
Dim Hoja_Destino As Worksheet, iLibro As Workbook
'Creamos ventana de diálogo para seleccionar los archivos que queremos agrupar
On Error Resume Next
dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS PARA CONSOLIDAR", MultiSelect:=True, filefilter:="Excel files (*.xls*), *.xls*")
On Error GoTo 0
'Si no seleccionamos archivos, salimos del proceso
If Not IsArray(dir_Archivo) Then
Exit Sub
End If
'Si existen datos en la hoja AGRUPADO, los eliminamos
With ThisWorkbook.Sheets("AGRUPADO")
elimina = Application.CountA(.Range("A:A"))
If elimina > 0 Then .Range("A1:A" & elimina).EntireRow.Delete
End With
'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)
'Determinamos a partir de que fila vamos a consolidar los datos
FilaInicio = 1
'Desactivamos actualización 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("AGRUPADO")
'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
'Iniciamos un bucle por cada hoja, extraemos los datos que nos interesan
'de cada hoja de cada archivo
For i = 1 To fin
n = Application.CountA(Hoja_Destino.Range("A:A")) + 1
'Traemos datos de la celda B5 de cada hoja
Hoja_Destino.Cells(n, 1) = iLibro.Sheets(i).Range("B5")
'Traemos datos de la celda B6 en cada hoja
Hoja_Destino.Cells(n, 2) = iLibro.Sheets(i).Range("B6")
n = n + 1
iLibro.Close False
Next i
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
Tan solo tenemos que pulsar el botón «AGRUPAR» y tendremos la información que hemos indicado agrupada en la hoja «AGRUPADO», es decir las celdas B5 y B6 de cada hoja y de cada archivo seleccionado:
Est tipo de macros resultan útiles cuando necesitamos agrupar datos con informaciones dispersas en la hoja, por ejemplo facturas, recibos, etc (siempre que tengan todas la misma estructura).
Y eso es todo, espero que os resulte de interés.
Descarga el archivo de ejemplo pulsando en: RECOPILAR INFORMACIÓN DE VARIAS CELDAS DE DISTINTOS ARCHIVOS EN UNA HOJA
¿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
