Bij indexering van tabbladen ook hyperlink maken

[eriksommeren]

Hallo allemaal,

met behulp van jullie is het gelukt om mijn excel bestand de tabbladen te laten indexeren. nu zou ik graag ook willen dat deze van de inhoud die hij in de cellen plaatst op de index pagina ook een hyperlink maakt naar het bijbehorende tabblad.

Sub Indexing()
  For Each sh In Sheets
    If sh.Name <> "0 Index" Then Sheets("0 Index").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3) = Split(sh.Name & "|" & Join(WorksheetFunction.Transpose(sh.Range("B4").Resize(2)), "|"), "|")
  Next
End Sub

Hierboven staat de code voor het indexeren van de tabbladen.

Als iemand een idee heeft, hoor ik het graag. Ik had zelf al geprobeerd door de een macro op te nemen maar dan maakt hij de link verkeer en de benaming van de link verkeerd. :S

Bij voorbaat dank,

Gr Erik

 

[HSV]

Niet van mezelf, maar wel bruikbaar.

Sub Indexing()
 Dim sh As Worksheet, c As Range
  For Each sh In Sheets
    If sh.Name <> "0 Index" Then Sheets("0 Index").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3) = Split(sh.Name & "|" & Join(WorksheetFunction.Transpose(sh.Range("B4").Resize(2)), "|"), "|")
  Next
 For Each c In Cells(2, 1).CurrentRegion
      ActiveSheet.Hyperlinks.Add anchor:=c, Address:="", SubAddress:="'" & c.Value & "'!A1", TextToDisplay:="Ga Naar " & c.Value 'maak er een hyperlink van
    Next
End Sub

 

[eriksommeren]

HSV heel erg bedankt,

Hij maakt er nu inderdaad links van, maar hij pakt alle tekst in het blad en maakt er een link van.

Het is de bedoeling dat hij begint met links maken bij cel A5 en dan naar beneden werkt (alleen in kolom A), de andere kolommen en cellen boven A5 moeten genegeerd worden.

Ik heb zelf al geprobeerd om de code aan te passen zodat deze werkt maar het is me nog niet gelukt.

Weet je hier misschien ook een oplossing voor?

Bvd. Erik

 

[HSV]

Probeer het zo eens Erik.

Sub Indexing()
 Dim sh As Worksheet, c As Range
  For Each sh In Sheets
    If sh.Name <> "0 Index" Then Sheets("0 Index").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3) = Split(sh.Name & "|" & Join(WorksheetFunction.Transpose(sh.Range("B4").Resize(2)), "|"), "|")
  Next
   With Sheets("0 Index")
 For Each c In Range("A5:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
  If c > 0 Then
      ActiveSheet.Hyperlinks.Add anchor:=c, Address:="", SubAddress:="'" & c.Value & "'!A1", TextToDisplay:="Ga Naar " & c.Value
    End If
   Next
  End With
End Sub

 

[eriksommeren]

Bedankt voor de reactie.

Hij doet het nu geweldig, super bedankt.

Gr Erik