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

Respuesta
1

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

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!! 

Respuesta

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 Sub

valora para finalizar saludos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas