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
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.
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:
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?
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 Subsal u dos