Macro para Consolidar Varias Hojas en 1 sola

Actualmente estoy diseñando un sistema para mi empresa el cual realiza las siguientes funciones.

Esta conformado por un archivo donde se crean tareas con su respectivo responsable de ejecutar la actividad, este archivo se entrega a varias personas que van a diligenciar la información, también cuenta con una macro que realiza la exportación de la información a otro archivo que se encuentra en una carpeta compartida de la organización.

El segundo archivo en el cual requiero de su ayuda consolida todas las hojas en las que se exportaron esos datos en una principal con el objetivo de visualizarlos en esta hoja con unos formularios, graficos, etc, el codigo se ejecuta al iniciar la macro y funciona muy bien, sin embargo debo crear un ciclo do while por cada hoja que quiero consolidar y en algunos equipos de bajo rendimiento da un error de compilación el cual dice que el procedimiento es demasiado largo.

http://www.mediafire.com/file/amdgf6kw56oibl7/Maestro+Plan+Unificado.xlsm

Seria de gran utilizada que la macro identifique la cantidad de hojas y repetirse ese mismo de veces, asi quedaria libre para aumentar la cantidad de hojas necesarias.

1 respuesta

Respuesta
1

Envíame un correo nuevo con lo siguiente:

Una hoja antes de la consolidación

3 hojas a consolidar

Otra hoja con el nombre "resultado", en esta hoja me pones el resultado de consolidar las 3 hojas.

Todas las hojas con nombres y datos reales.

Señor Dante, acabo de enviar el correo electrónico que me solicito. 

Te anexo la macro

Sub Consolidar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Registros")    'hoja con el consolidado
    h1.Range("A2:T" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1) = Empty
    i = 2
    For Each h In Sheets
        If Left(LCase(h.Name), 16) = "datos importados" 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

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas