Crear hojas con hipernvinculo desde un listado en excel
Tengo un listado de códigos en la hoja1 y debo generar una hoja para cada uno y con hiperviculo desde la hoja1, como puedo realizar esto automático ya que el listado de códigos es largo y se modifica semanalmente, adicional a esto varian las cantidades de códigos.
2 Respuestas
Te anexo la macro. Pon el listado en la "Hoja1", columna "A", iniciando en la fila 2.
Sub ListadoConHipervinculo()
'Por.Dante Amor
col = "A"
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
For i = 2 To h1.Range(col & Rows.Count).End(xlUp).Row
hoja = h1.Cells(i, col)
existe = False
For Each h In Sheets
If UCase(h.Name) = UCase(hoja) Then
existe = True
Exit For
End If
Next
If existe = False Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = hoja
End If
h1.Hyperlinks.Add Anchor:=h1.Cells(i, col), Address:="", _
SubAddress:=hoja & "!A1", TextToDisplay:=hoja
Next
h1.Select
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Muchas gracias! Ya la ensaye y efectivamente funciona, pero hasta una fila específica del archivo, no llega hasta la ultima fila diligenciada tal como esta en la programación.
Doy clic en depurar y queda en este renglón:
h1.Hyperlinks.Add Anchor:=h1.Cells(i, col), Address:="", _
SubAddress:=hoja & "!A1", TextToDisplay:=hoja
Sabiendo que funciona, quisiera pedirle si es posible, que en cada hoja que cree, en una celda definida me genere el hipervínculo para volver a la Hoja1.
Muchas gracias!
La macro funciona para llegar hasta la última fila con datos de la columna A.
Revisa que no tengas espacios después del último dato.
También revisa si ya existe la hoja, si ya existe la hoja solamente realiza el hipervículo.
Con todo gusto te ayudo con todas tus peticiones, pero deberás valorar la respuesta y crear una nueva pregunta por cada petición.
Si continúa el problema, envíame tu archivo para revisarlo y me dices exactamente en dónde está el problema.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Diego Herrera Franco” y el título de esta pregunta.
Revisa el código de la hoja que no pudo crear, revisa que tenga un dato válido para nombre de hoja, es decir, que no tenga caracteres especiales, que no mida más de 30 caracteres, que no esté repetido.
También dime qué mensaje de error te aparece cuando la macro se detiene.
.
Buenos días, Diego
Te comparto un código que genera hojas a partir de una hoja-plantilla que está en blanco y que se agrega con el nombre que aparece en el listado y deja un hipervínculo a la hoja creada.
Es muy probable que haya que ajustar algunas cuestiones, como por ejemplo qué hacer cuando encuentra una hoja creada anteriormente.
Dado que repetirás esta rutina semanalmente, voy a suponer que las hojas pre existentes NO deben ser reemplazadas, sino sólo agregar las nuevas.
Luego me dirás si esto es correcto o hay algún ajuste que hacer.
Vé al Editor de VBA (atajo: Alt + F11) inserta un módulo nuevo y pega todo esto en él:
Public ColLetr
Public CeldaTit
Public Cont
Sub creatodas()
'Diego, completa estas variables:
ColLetr = "C8:C40000" 'escribir rango amplio donde están los Codigos:
CeldaTit = "D4" ' Celda dentro de la hoja creada donde colocar el código correspondiente
'-------------------------
'control de columna con nombres
Set isect = Application.Intersect(Range(ColLetr), ActiveCell)
If isect Is Nothing Or Len(ActiveCell.Value) < 1 Then
MsgBox "Esta rutina sólo funciona para un código ingresado en la columna " & Left(ColLetr, 1) & Chr(10) & "NO se agrega hoja alguna." & Chr(10), vbExclamation, "AREA ERRONEA"
GoTo TheEnd
End If
HojaPrinc = ActiveSheet.Name
For Each CODIGO In Range(ColLetr)
CODIGO.Select
If IsEmpty(CODIGO) Then GoTo FIN
Call AddNSht
Sheets(HojaPrinc).Select
Next
FIN:
MsgBox "Listo! Se agregaron " & Cont & "hojas.", vbInformation
TheEnd:
Set isect = Nothing
End Sub
Sub AddNSht()
'
'by FeJoAl
'
HojaPrinc = ActiveSheet.Name
NombHoja = ActiveCell.Value
'control de existencia de Hoja
On Error Resume Next
Set HojaObjeto = ActiveWorkbook.Sheets(NombHoja)
If Err = 0 Then GoTo TheEnd2 ' Hoja existe ===> No hacer nada
On Error GoTo 0
Application.ScreenUpdating = False
Cod_Name = NombHoja
Sheets("_UltCod").Visible = True
Sheets("_Template").Visible = True
Sheets("_UltCod").Select
Sheets("_Template").Copy Before:=ActiveSheet
Sheets("_UltCod").Select
ActiveSheet.Previous.Select
Range(CeldaTit).Value = Cod_Name
ActiveSheet.Name = NombHoja
Cont = Cont + 1
Sheets("_Template").Visible = False
Sheets("_UltCod").Visible = False
Sheets(HojaPrinc).Select
' coloca hypervinculo y fórmulas en el listado
vinc = "'" & ActiveCell.Value & "'!" & CeldaTit
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=vinc
Sheets(NombHoja).Select
Application.ScreenUpdating = True
TheEnd2:
Set HojaObjeto = Nothing
End Sub
Verás que incluye dos macros
AddNews que agrega hoja por hoja.
CreaTodas, que ejecuta la anterior, recorriendo el listado que tengas en la columna que le indicaste hasta que encuentra una celda en blanco.
La Hoja que llamé "_Templat"e es aquella que se duplicará cada vez que cree una.
Si ya tienes una creada, y sin datos, cámbiale el nombre por el indicado. Verás que esta hoja permanecerá oculta para preservarla.
Tendrás que agregar al final una hoja que se llame "_UltCod". En blanco, es sólo una guia.
Verás en el principio que te dejé indicadas algunas variables para que completes con los datos reales de tu archivo: uno es el rango donde están los códigos, amplio para que incluya los que agregues posteriormente. Y una celda de la hoja creada donde estárá indicado el nombre del código que creó.
Bueno, más largo de escribir que de hacer, espero que te sea de ayuda.
En caso de que tuvieras que modificar su comportamiento, avisame y lo ajustamos.
Abrazo
Fernando
(Buenos Aires, Argentina)
.