Cómo integrar la información de varias hojas de excel en una?
Tengo un archivo de Excel con 5 pestañas, de las cuales 3 (hoja 1, 2 y 3) tienen el mismo encabezado y con diferentes datos cada uno. Y necesito juntar toda la información en la hoja 6 (Seguimiento TOTAL), sin integrar las que están vacías y dejar las otras dos hojas (4 y 5) sin tocar!
Ya vi que con una macro se podría hacer "facilmente" el problema es que yo no se hacerlas.
¿Alguien me puede ayudar? Me urge!
2 Respuestas
. 06.04.17 #VBA consolidar/juntar hojas en una
Buenas tardes, Montse
Dada tu urgencia, te contesto aquí pues no sé donde la leerás primero.
La rutina que te armé hace lo que solicitas.
Al principio de ella, notarás unas variables donde informarle en qué hoja juntar todo y a partir de qué celda. Al fin de la prueba, usé unos rango que pueden diferir de los tuyos, pero puedes reemplazarla por la que quieras en esas variables.
También hay una variable matriz, que te permite agregar varias hojas o cambiarle el nombre.
El procedimiento se encargará de copiar y pegar los datos de todas las hojas que informes allí.
Con eso en mente y considerando que actualmente cada hoja de MS Excel cuenta con apenas un poco más de un millón de lineas, haz lo siguiente:
Accede al Editor de VBA (Atajo: Alt + F11), inserta un módulo - si no tuvieras uno ya- y pega el siguiente código:
Sub Rejunta()
' MONTSE, reemplaza el contenido de estas dos variables por los correspondientes a tu archivo:
HojaDest = "Seguimiento Total" 'Hoja donde consolidar las otras
CeldaIni = "A2" ' celda donde empezar a pegar el contenido de las otras hojas
HojaAtraer = Array("Hoja 1", "Hoja 2", "Hoja 3") ' incluir aquí los nombres de las hojas a incluir en la consolidada
TitOrigen = "B2:N2" 'Rango donde están los títulos de las hojas a traer
'---- fin Variables
'
' VBA coding by FeJoAl
'
'---- inicio de rutina:
'
'Borrado de datos anteriores
'
Sheets(HojaDest). Range(Range(CeldaIni). Offset(1), Sheets(HojaDest). Range(CeldaIni). SpecialCells(xlLastCell). Address). Clear
'Ciclo de consolidación de hojas
'
For laHoja = 0 To UBound(HojaAtraer)
Application.ScreenUpdating = False
UltFilaD = Cells(Cells(Rows.Count, Sheets(HojaDest).Range(CeldaIni).Column).End(xlUp).Row + 1, Sheets(HojaDest).Range(CeldaIni).Column).Address
HojaCop = HojaAtraer(laHoja)
With Sheets(HojaCop)
UltFila = .Range(TitOrigen).SpecialCells(xlLastCell).Address
.Range(.Range(TitOrigen).Offset(1), .Range(UltFila)).Copy
ElMensaje = ElMensaje & Chr(10) & HojaCop
Sheets(HojaDest).Range(UltFilaD).PasteSpecial xlPasteValues
Sheets(HojaDest).Range(UltFilaD).PasteSpecial xlFormats
Application.CutCopyMode = False
cont = cont + 1
End With
Application.ScreenUpdating = True
Next
Sheets(HojaDest).UsedRange.EntireColumn.AutoFit
'Eliminación de filas vacías:
'
UltCelda = Sheets(HojaDest).Range(CeldaIni).SpecialCells(xlLastCell).Address
ElRango = Range(Range(CeldaIni), UltCelda).Address
For LaFila = Range(ElRango).Rows.Count - 1 To 0 Step -1
ChkCount = Range(Range(CeldaIni). Offset(LaFila), Range(CeldaIni). Offset(LaFila, Range(ElRango). Columns. Count)). Address
ChkCount = Application.WorksheetFunction.CountA(Range(ChkCount))
If ChkCount = 0 Then Range(CeldaIni).Offset(LaFila).EntireRow.Delete
Next
Range(CeldaIni).Select
Application.ScreenUpdating = True
ElMensaje = IIf(cont = 0, "NO SE TRASLADO HOJA ALGUNA", "Se transfirieron a la hoja " & HojaDest & Chr(10) & " las siguientes " & cont & " hojas:" & Chr(10) & ElMensaje)
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End SubPruebalo 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.
Fer:
Eres lo máximo!! ¡Mil Gracias! Es justo lo que necesitaba, tu ayuda y disposición es increíble! Me siento muy afortunada de haber contado con tus conocimientos!! Y espero seguir aprendiendo de ti en el futuro.
100% recomendable, tanto por amabilidad como por conocimientos y por dar ese extra que tanto nos hace falta en esta vida!!
Una vez más, mil gracias!!
Te paso la macro de dante amor
Sub Consolidar()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Seguimiento TOTAL") 'hoja con el consolidado
h1.Range("A2:Z" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1) = Empty
i = 2
For Each h In Sheets
If h.Name <> h1.Name Then
j = 2
n = 1
Do While h.Cells(j, "B") <> ""
h1.Cells(i, 1) = n
For k = 2 To 20
h1.Cells(i, k) = h.Cells(j, k)
Next
i = i + 1
j = j + 1
n = n + 1
Loop
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Subvalora para finalizar saludos!