Consolidar Varias Hojas en 1 Hoja

Actualmente tengo una macro que debe recorrer determinadas hojas, desde la hoja 9 hasta la hoja 34 y debe consolidar la información en solo una, el problema es que algunas de estas van a estar vacías, la macro debe recorrer hoja por hoja y consolidarlas en 1, si en la primer hoja hay 3 registros y en la segunda hay 4 registros, estos últimos deben empezar desde la fila 4, pues la filas del 1 al 3 ya tienen información cargada, este código lo hace pero no me agrega la información en la siguiente casilla vacía, pues la primer hoja la organiza bien, sin embargo cuando va a cargar información de la siguiente hoja sobre escribe la información.

Dim i1, j1, h, d As Integer

For d = 9 To 39

i1 = 2
j1 = 2
n = 1

Do While Sheets(d).Cells(i1, 2) <> ""

Hoja3.Cells(j1, 1) = n
Hoja3.Cells(j1, 2) = Sheets(d).Cells(i1, 2)
Hoja3.Cells(j1, 3) = Sheets(d).Cells(i1, 3)
Hoja3.Cells(j1, 4) = Sheets(d).Cells(i1, 4)
Hoja3.Cells(j1, 5) = Sheets(d).Cells(i1, 5)
Hoja3.Cells(j1, 6) = Sheets(d).Cells(i1, 6)
Hoja3.Cells(j1, 7) = Sheets(d).Cells(i1, 7)
Hoja3.Cells(j1, 8) = Sheets(d).Cells(i1, 8)
Hoja3.Cells(j1, 9) = Sheets(d).Cells(i1, 9)
Hoja3.Cells(j1, 10) = Sheets(d).Cells(i1, 10)
Hoja3.Cells(j1, 11) = Sheets(d).Cells(i1, 11)
Hoja3.Cells(j1, 12) = Sheets(d).Cells(i1, 12)
Hoja3.Cells(j1, 13) = Sheets(d).Cells(i1, 13)
Hoja3.Cells(j1, 14) = Sheets(d).Cells(i1, 14)
Hoja3.Cells(j1, 15) = Sheets(d).Cells(i1, 15)
Hoja3.Cells(j1, 16) = Sheets(d).Cells(i1, 16)
Hoja3.Cells(j1, 17) = Sheets(d).Cells(i1, 17)
Hoja3.Cells(j1, 18) = Sheets(d).Cells(i1, 18)
Hoja3.Cells(j1, 19) = Sheets(d).Cells(i1, 19)
Hoja3.Cells(j1, 20) = Sheets(d).Cells(i1, 20)

n = n + 1
j1 = j1 + 1
i1 = i1 + 1
Loop

Next

2 Respuestas

Respuesta
1

No he probado como se comporta la macro, pero por que no pruebas cambiando el "do White - loop" por un "While - wend", do While primero ejecuta y después analiza, y While primero analiza y después ejecuta. Espero te sirva, si no me dices y lo revisamos a detalle.

https://carvajal-my.sharepoint.com/personal/donoban_tigreros_carvajal_com/_layouts/

Marcos, no me quedo clara la explicación, de todas maneras adjunte un archivo de ejemplo para que lo valides, en este tengo 2 rutinas, una que se llama Sub hoja en la cual tengo la rutina mencionada anteriormente y otra que se llama Sub Original y es el código que tengo actualmente, solo que como podrás ver me toca hacer un Do While por cada hoja y teniendo en cuenta que pueden llegar a ser muchas, en computadores con bajo procesamiento me sale un error de compilación que dice, PROCEDIMIENTO DEMASIADO LARGO

Sub Original()

Dim i1, j1, h As Integer
i1 = 2
j1 = 2
n = 1
Hoja1.Range("A2:R1000") = Empty


Do While Hoja9.Cells(i1, 2) <> ""

Hoja1.Cells(j1, 1) = n
Hoja1.Cells(j1, 2) = Hoja9.Cells(i1, 2)
Hoja1.Cells(j1, 3) = Hoja9.Cells(i1, 3)
Hoja1.Cells(j1, 4) = Hoja9.Cells(i1, 4)
Hoja1.Cells(j1, 5) = Hoja9.Cells(i1, 5)
Hoja1.Cells(j1, 6) = Hoja9.Cells(i1, 6)
Hoja1.Cells(j1, 7) = Hoja9.Cells(i1, 7)
Hoja1.Cells(j1, 8) = Hoja9.Cells(i1, 8)
Hoja1.Cells(j1, 9) = Hoja9.Cells(i1, 9)
Hoja1.Cells(j1, 10) = Hoja9.Cells(i1, 10)
Hoja1.Cells(j1, 11) = Hoja9.Cells(i1, 11)
Hoja1.Cells(j1, 12) = Hoja9.Cells(i1, 12)
Hoja1.Cells(j1, 13) = Hoja9.Cells(i1, 13)
Hoja1.Cells(j1, 14) = Hoja9.Cells(i1, 14)
Hoja1.Cells(j1, 15) = Hoja9.Cells(i1, 15)
Hoja1.Cells(j1, 16) = Hoja9.Cells(i1, 16)
Hoja1.Cells(j1, 17) = Hoja9.Cells(i1, 17)
Hoja1.Cells(j1, 18) = Hoja9.Cells(i1, 18)
Hoja1.Cells(j1, 19) = Hoja9.Cells(i1, 19)
Hoja1.Cells(j1, 20) = Hoja9.Cells(i1, 20)

n = n + 1
j1 = j1 + 1
i1 = i1 + 1
Loop

i1 = 2

Do While Hoja10.Cells(i1, 2) <> ""

Hoja1.Cells(j1, 1) = n
Hoja1.Cells(j1, 2) = Hoja10.Cells(i1, 2)
Hoja1.Cells(j1, 3) = Hoja10.Cells(i1, 3)
Hoja1.Cells(j1, 4) = Hoja10.Cells(i1, 4)
Hoja1.Cells(j1, 5) = Hoja10.Cells(i1, 5)
Hoja1.Cells(j1, 6) = Hoja10.Cells(i1, 6)
Hoja1.Cells(j1, 7) = Hoja10.Cells(i1, 7)
Hoja1.Cells(j1, 8) = Hoja10.Cells(i1, 8)
Hoja1.Cells(j1, 9) = Hoja10.Cells(i1, 9)
Hoja1.Cells(j1, 10) = Hoja10.Cells(i1, 10)
Hoja1.Cells(j1, 11) = Hoja10.Cells(i1, 11)
Hoja1.Cells(j1, 12) = Hoja10.Cells(i1, 12)
Hoja1.Cells(j1, 13) = Hoja10.Cells(i1, 13)
Hoja1.Cells(j1, 14) = Hoja10.Cells(i1, 14)
Hoja1.Cells(j1, 15) = Hoja10.Cells(i1, 15)
Hoja1.Cells(j1, 16) = Hoja10.Cells(i1, 16)
Hoja1.Cells(j1, 17) = Hoja10.Cells(i1, 17)
Hoja1.Cells(j1, 18) = Hoja10.Cells(i1, 18)
Hoja1.Cells(j1, 19) = Hoja10.Cells(i1, 19)
Hoja1.Cells(j1, 20) = Hoja10.Cells(i1, 20)

n = n + 1
j1 = j1 + 1
i1 = i1 + 1
Loop


i1 = 2

Do While Hoja11.Cells(i1, 2) <> ""

Hoja1.Cells(j1, 1) = n
Hoja1.Cells(j1, 2) = Hoja11.Cells(i1, 2)
Hoja1.Cells(j1, 3) = Hoja11.Cells(i1, 3)
Hoja1.Cells(j1, 4) = Hoja11.Cells(i1, 4)
Hoja1.Cells(j1, 5) = Hoja11.Cells(i1, 5)
Hoja1.Cells(j1, 6) = Hoja11.Cells(i1, 6)
Hoja1.Cells(j1, 7) = Hoja11.Cells(i1, 7)
Hoja1.Cells(j1, 8) = Hoja11.Cells(i1, 8)
Hoja1.Cells(j1, 9) = Hoja11.Cells(i1, 9)
Hoja1.Cells(j1, 10) = Hoja11.Cells(i1, 10)
Hoja1.Cells(j1, 11) = Hoja11.Cells(i1, 11)
Hoja1.Cells(j1, 12) = Hoja11.Cells(i1, 12)
Hoja1.Cells(j1, 13) = Hoja11.Cells(i1, 13)
Hoja1.Cells(j1, 14) = Hoja11.Cells(i1, 14)
Hoja1.Cells(j1, 15) = Hoja11.Cells(i1, 15)
Hoja1.Cells(j1, 16) = Hoja11.Cells(i1, 16)
Hoja1.Cells(j1, 17) = Hoja11.Cells(i1, 17)
Hoja1.Cells(j1, 18) = Hoja11.Cells(i1, 18)
Hoja1.Cells(j1, 19) = Hoja11.Cells(i1, 19)
Hoja1.Cells(j1, 20) = Hoja11.Cells(i1, 20)

n = n + 1
j1 = j1 + 1
i1 = i1 + 1
Loop

i1 = 2

Do While Hoja12.Cells(i1, 2) <> ""

Hoja1.Cells(j1, 1) = n
Hoja1.Cells(j1, 2) = Hoja12.Cells(i1, 2)
Hoja1.Cells(j1, 3) = Hoja12.Cells(i1, 3)
Hoja1.Cells(j1, 4) = Hoja12.Cells(i1, 4)
Hoja1.Cells(j1, 5) = Hoja12.Cells(i1, 5)
Hoja1.Cells(j1, 6) = Hoja12.Cells(i1, 6)
Hoja1.Cells(j1, 7) = Hoja12.Cells(i1, 7)
Hoja1.Cells(j1, 8) = Hoja12.Cells(i1, 8)
Hoja1.Cells(j1, 9) = Hoja12.Cells(i1, 9)
Hoja1.Cells(j1, 10) = Hoja12.Cells(i1, 10)
Hoja1.Cells(j1, 11) = Hoja12.Cells(i1, 11)
Hoja1.Cells(j1, 12) = Hoja12.Cells(i1, 12)
Hoja1.Cells(j1, 13) = Hoja12.Cells(i1, 13)
Hoja1.Cells(j1, 14) = Hoja12.Cells(i1, 14)
Hoja1.Cells(j1, 15) = Hoja12.Cells(i1, 15)
Hoja1.Cells(j1, 16) = Hoja12.Cells(i1, 16)
Hoja1.Cells(j1, 17) = Hoja12.Cells(i1, 17)
Hoja1.Cells(j1, 18) = Hoja12.Cells(i1, 18)
Hoja1.Cells(j1, 19) = Hoja12.Cells(i1, 19)
Hoja1.Cells(j1, 20) = Hoja12.Cells(i1, 20)

n = n + 1
j1 = j1 + 1
i1 = i1 + 1
Loop

i1 = 2

Do While Hoja13.Cells(i1, 2) <> ""

Hoja1.Cells(j1, 1) = n
Hoja1.Cells(j1, 2) = Hoja13.Cells(i1, 2)
Hoja1.Cells(j1, 3) = Hoja13.Cells(i1, 3)
Hoja1.Cells(j1, 4) = Hoja13.Cells(i1, 4)
Hoja1.Cells(j1, 5) = Hoja13.Cells(i1, 5)
Hoja1.Cells(j1, 6) = Hoja13.Cells(i1, 6)
Hoja1.Cells(j1, 7) = Hoja13.Cells(i1, 7)
Hoja1.Cells(j1, 8) = Hoja13.Cells(i1, 8)
Hoja1.Cells(j1, 9) = Hoja13.Cells(i1, 9)
Hoja1.Cells(j1, 10) = Hoja13.Cells(i1, 10)
Hoja1.Cells(j1, 11) = Hoja13.Cells(i1, 11)
Hoja1.Cells(j1, 12) = Hoja13.Cells(i1, 12)
Hoja1.Cells(j1, 13) = Hoja13.Cells(i1, 13)
Hoja1.Cells(j1, 14) = Hoja13.Cells(i1, 14)
Hoja1.Cells(j1, 15) = Hoja13.Cells(i1, 15)
Hoja1.Cells(j1, 16) = Hoja13.Cells(i1, 16)
Hoja1.Cells(j1, 17) = Hoja13.Cells(i1, 17)
Hoja1.Cells(j1, 18) = Hoja13.Cells(i1, 18)
Hoja1.Cells(j1, 19) = Hoja13.Cells(i1, 19)
Hoja1.Cells(j1, 20) = Hoja13.Cells(i1, 20)

n = n + 1
j1 = j1 + 1
i1 = i1 + 1
Loop

i1 = 2

Creo que entendí que necesitas, te sugiero algunos cambios en la macro que tienes. Prueba con la macro así :

Dim i1, j1, h, d As Integer

For d = 9 To 39

i1 = 2
j1 = 2
n = 0

While sheets(Hoja3). Cells(j1 +n, 2) <>""

n = n +1

Wend

j1 = j1+n

Do While Sheets(d).Cells(i1, 2) <> ""

Hoja3.Cells(j1, 1) = n
Hoja3.Cells(j1, 2) = Sheets(d).Cells(i1, 2)
Hoja3.Cells(j1, 3) = Sheets(d).Cells(i1, 3)
Hoja3.Cells(j1, 4) = Sheets(d).Cells(i1, 4)
Hoja3.Cells(j1, 5) = Sheets(d).Cells(i1, 5)
Hoja3.Cells(j1, 6) = Sheets(d).Cells(i1, 6)
Hoja3.Cells(j1, 7) = Sheets(d).Cells(i1, 7)
Hoja3.Cells(j1, 8) = Sheets(d).Cells(i1, 8)
Hoja3.Cells(j1, 9) = Sheets(d).Cells(i1, 9)
Hoja3.Cells(j1, 10) = Sheets(d).Cells(i1, 10)
Hoja3.Cells(j1, 11) = Sheets(d).Cells(i1, 11)
Hoja3.Cells(j1, 12) = Sheets(d).Cells(i1, 12)
Hoja3.Cells(j1, 13) = Sheets(d).Cells(i1, 13)
Hoja3.Cells(j1, 14) = Sheets(d).Cells(i1, 14)
Hoja3.Cells(j1, 15) = Sheets(d).Cells(i1, 15)
Hoja3.Cells(j1, 16) = Sheets(d).Cells(i1, 16)
Hoja3.Cells(j1, 17) = Sheets(d).Cells(i1, 17)
Hoja3.Cells(j1, 18) = Sheets(d).Cells(i1, 18)
Hoja3.Cells(j1, 19) = Sheets(d).Cells(i1, 19)
Hoja3.Cells(j1, 20) = Sheets(d).Cells(i1, 20) 

j1 = j1 + 1
i1 = i1 + 1
Loop

Next d

Prueba y si necesitas algo más avisame.

Respuesta
1

H   o l a:

Te anexo algunas observaciones. Cuando declaras variables de esta forma, la única variable que estás declarando como Integer es la "d", las otras quedan como Variant

Dim i1, j1, h, d As Integer

La forma correcta sería así:

Dim i1 as integer, j1 as integer, h as integer, d As Integer

Además no es necesario declarar las variables en VBA, solamente en algunos casos. Más sobre variables:

Macro que al hacer clic en agregar una hoja nueva me aparezca un mensaje que diga estas seguro que deseas agregar una nueva hoja


El contador j1, es la fila de la hoja3, lo inicias con el número 2 cada vez que cambia de hoja. Tienes que iniciarlo una sola vez antes del For, podría quedar así:

Sub Consolidar()
    j1 = 2
    For d = 9 To 39
        i1 = 2
        n = 1
        Do While Sheets(d).Cells(i1, 2) <> ""
            Hoja3.Cells(j1, 1) = n
            Hoja3.Cells(j1, 2) = Sheets(d). Cells(i1, 2)
            Hoja3.Cells(j1, 3) = Sheets(d). Cells(i1, 3)
            Hoja3.Cells(j1, 4) = Sheets(d). Cells(i1, 4)
            Hoja3.Cells(j1, 5) = Sheets(d). Cells(i1, 5)
            Hoja3.Cells(j1, 6) = Sheets(d). Cells(i1, 6)
            Hoja3.Cells(j1, 7) = Sheets(d). Cells(i1, 7)
            Hoja3.Cells(j1, 8) = Sheets(d). Cells(i1, 8)
            Hoja3.Cells(j1, 9) = Sheets(d). Cells(i1, 9)
            Hoja3.Cells(j1, 10) = Sheets(d). Cells(i1, 10)
            Hoja3.Cells(j1, 11) = Sheets(d). Cells(i1, 11)
            Hoja3.Cells(j1, 12) = Sheets(d). Cells(i1, 12)
            Hoja3.Cells(j1, 13) = Sheets(d). Cells(i1, 13)
            Hoja3.Cells(j1, 14) = Sheets(d). Cells(i1, 14)
            Hoja3.Cells(j1, 15) = Sheets(d). Cells(i1, 15)
            Hoja3.Cells(j1, 16) = Sheets(d). Cells(i1, 16)
            Hoja3.Cells(j1, 17) = Sheets(d). Cells(i1, 17)
            Hoja3.Cells(j1, 18) = Sheets(d). Cells(i1, 18)
            Hoja3.Cells(j1, 19) = Sheets(d). Cells(i1, 19)
            Hoja3.Cells(j1, 20) = Sheets(d). Cells(i1, 20)
            n = n + 1
            j1 = j1 + 1
            i1 = i1 + 1
        Loop
    Next
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Muchas Gracias de Antemano por su pronta respuesta sin embargo los 2 códigos me generan error, me dan error en intervalo. 

podrían revisar el ejemplo que les dejo en el link?

https://carvajal-my.sharepoint.com/personal/donoban_tigreros_carvajal_com/_layouts/15/guestaccess.aspx?docid=119f4a2db58ed4f86820225d2fc4ee0d0&authkey=AfEDDtj3yRvMO0Y7w-tUMSM

Yo ejecuté la macro y no tuve problemas

Qué mensaje de error te aparece y en cuál línea de la macro se detiene.

No puedo descargar archivos. Mejor envíame el archivo por correo.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Donoban Henry Tigreros Ardila” y el título de esta pregunta.

Te anexo la macro actualizada. Cambia "Hoja1" por el nombre de la hoja que va a tener la consolidación.

Sub Consolidar()
'Act.Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")    '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

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas