Cómo integrar la información de varias hojas de excel en una?

. 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 Sub

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.