Macro que recorra una columna en una tabla y renombre nuevas hojas
Tengo un archivo de excel con varias Hojas. Una de ellas se llama "TRIM" y oculta tengo una hoja plantilla llamada "APU-".
Lo que necesito es que la Macro recorra la columna "Código" de la tabla TRIM, en la que están los nombres. Luego copie la hoja oculta tantas veces nombres encuentre en la columna Código de la Tabla APU y renombre esas hojas copiadas.
Si en la Columna "Código" tengo A, B, C, D, E, F... La debería tener al final la hoja oculta copiada y renombrada como APU-A, APU-B, APU-C, APU-E, APU-F.
1 respuesta
H o l a: Te anexo la macro
Sub Copiar_Hoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("TRIM")
Set h2 = Sheets("APU-")
valor = h2.Visible
h2.Visible = -1
'
col = "A" 'columna código
fil = 2 'fila donde empiezan los nombres
'
For i = fil To h1.Range(col & Rows.Count).End(xlUp).Row
nombre = Left(h2.Name & h1.Cells(i, col), 30)
h2.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nombre
Next
h2.Visible = valor
Application.ScreenUpdating = True
MsgBox "Fin"
End SubSi quieres que las nuevas hojas también queden ocultas, entonces después de esta línea:
ActiveSheet.Name = nombre
agrega esta línea:
ActiveSheet.Visible = 0
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
La macro funciona perfecto. Le haré algunos cambios que una vez probados la traeré acá. Los cambios serían la de ocultar la Hoja Plantilla una vez creadas las hojas APU.
Por otro lado, una vez creadas las hojas APU, la macro así como está me arroja el siguiente error
"Se ha producido un error '1004' en tiempo de ejecución: Este nombre ya está ocupado, pruebe con uno distinto"
Y me crea una hoja llamada APU-(2)
¿A qué puede deberse?
Gracias, nuevamente, de antemano
Analizando, creo que le falta alguna línea de código en la que "entienda" que a la primera celda vacía en la columna que inspecciona salga de la rutina y termine. No estoy seguro
En la columna A, desde la fila 2 hacia abajo, debes tener únicamente nombre que al juntarse con la palabra "APU-" no exista la hoja.
Me sigue dando el error. Creo que al encontrar una celda vacía intenta crear la hoja "APU- " y como la Hoja Plantilla se llama así, salta el error. Incluso me crea una Hoja adicional "APU-(2)" (¿?)
Tengo en la columna A, letras desde la A hasta la K. Crea todo bien, "APU-A, APU-B, APU-C (...) APU-K". Hasta allí perfecto. Luego me crea la Hoja "APU-(2)" y me da el mensaje de error. Nunca llega a mostrar el MsgBox de "FIN"
¿Pudiera dar ese error si lo que tengo es una Tabla en vez de un rango?
Revisa que después de la letra K no tengas celdas con espacios, es posible que dentro de la celda A13 tengas un espacio; es muy simple, solamente selecciona las celdas desde la A13 hacia abajo y borra el contenido.
Pero de todos modos te anexo el cambio en la macro
Sub Copiar_Hoja()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("TRIM")
Set h2 = Sheets("APU-")
valor = h2.Visible
h2.Visible = -1
'
col = "A" 'columna código
fil = 2 'fila donde empiezan los nombres
'
For i = fil To h1.Range(col & Rows.Count).End(xlUp).Row
if h1.cells(i, col) = "" or h1.cells(i, col) = " " then
else
nombre = Left(h2.Name & h1.Cells(i, col), 30)
h2.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nombre
end if
Next
h2.Visible = valor
Application.ScreenUpdating = True
MsgBox "Fin"
End Subsal u dos
¡Gracias!
Desde el principio la Macro funcionaba perfecto. Como bien dices, en alguna celda bajo el último valor había algún espacio o carácter oculto. Seleccioné todo ese rango y borré. La macro funcionó sin error alguno.
Gracias, nuevamente.
