Insertar hipervínculo a hoja según recorre columna
Hace unos días me realizó una macro que recorría la columna B y si encontraba la palabra "Partida" me creaba una carpeta con el nombre del dato de la misma fila en la columna A de la palabra "Partida" y me va de maravilla y mi pregunta es, se puede hacer un hipervínculo que al hacer clik en cada celda columna A donde está la palabra "Partida" me lleve a cada hoja, adjunto macro que me creo Sr.Dante Amor:
Sub CopiarPlantilla()
'Por.Dante Amor
Set h1 = Sheets("PRESUPUESTO FINAL")
Set h2 = Sheets("PLANTILLAMADERA1")
Set r = h1.Columns("B")
Set b = r.Find("Partida", lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
existe = False
nombre = h1.Cells(b.Row, "A")
For Each h In Sheets
If UCase(h.Name) = UCase(nombre) Then
existe = True
Exit For
End If
Next
'
If existe = False Then
h2.Copy After:=Sheets(Sheets.Count)
Set h3 = ActiveSheet
For Each tabla In h3.ListObjects
tabla.Name = nombre
h3.Name = nombre
h3.Range("A1") = nombre
Exit For
Next
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
MsgBox "Fin"
End Sub
1 respuesta
Te anexo la macro actualizada para el hipervínculo
Sub CopiarPlantilla()
'Por.Dante Amor
Set h1 = Sheets("PRESUPUESTO FINAL")
Set h2 = Sheets("PLANTILLAMADERA1")
Set r = h1.Columns("B")
Set b = r.Find("Partida", lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
existe = False
nombre = h1.Cells(b.Row, "A")
For Each h In Sheets
If UCase(h.Name) = UCase(nombre) Then
existe = True
Exit For
End If
Next
'
If existe = False Then
h2.Copy After:=Sheets(Sheets.Count)
Set h3 = ActiveSheet
For Each tabla In h3.ListObjects
tabla.Name = nombre
h3.Name = nombre
h3.Range("A1") = nombre
Exit For
Next
End If
h1.Select
h1.Hyperlinks.Add Anchor:=h1.Cells(b.Row, "A"), Address:="", _
SubAddress:=nombre & "!A1" ', TextToDisplay:=nombre
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
