Hyperlink per Makro erstellen

Question

Hallo liebe Excelianer,

ich habe eine xlsm Datei, die 140 einzelne Tabellenblätter hat. in jeden einzelnen Blatt befindet sich die Kalkulation für ein Produkt von uns. Ich habe nun ein Übersichtsblatt angefertigt, um alle Produkte auf einen Blick zu sehen. ich habe es sogar hinbekommen, dass alle Blattnamen per Makro erfasst und in das Übersichtsblatt geschrieben warden. Hier der Code, der auch wunderbar funktioniert.

Sub Sheet_Names()

Dim lngworksheets As Long
Dim i As Long

lngworksheets = ThisWorkbook.Sheets.Count

For i = ThisWorkbook.Worksheets("Base").Index + 2 To lngworksheets
ThisWorkbook.Sheets("Base").Cells(2 + i - ThisWorkbook.Worksheets("Base").Index - 1, 3).Value = ThisWorkbook.Worksheets(i).Name
Next i

End Sub

ich habe nun aber noch das Ziel, per Makro Hyperlinks vom Übersichtsblatt "Base" zu den einzelnen Tabellen zu erstellen, indem ich einfach auf den Namen klicke. Und genau hier komme ich nicht weiter. Am liebsten würde ich in die Schleife die Hyperlink Funktion einbauen, aber ich komme leider nicht damit klar. Am Ende möchte ich lediglich auf den Namen klicken und so zum dazugehörigen Tabellenblatt gelangen. Irgendwie muss dass doch gehen.

Es ware ganz toll, wenn Ihr mir helfen könntet. In jeden Fall wünsche ich Euch ein schönes Wochenende.

Vielen Dank vorab.

Gruss

Peter

Answer 1

Hallo Peter :-)

Reicht da nicht das Seections Ereignis?

Ein Beispiel!

Einzufügen Alt+F11/Projektexplorer/DeineSteuerTabelle

Zur Zeit werden die Namen in Spalte A vorausgesetzt!
Eine Selection der Zelle bewirkt den Tabellenwechsel

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
Application.EnableEvents = False
Worksheets("" & Target).Activate
Application.EnableEvents = True
End If
End Sub

Gruss Nighty

Answer 2

hi all ^^

Das ein/ausschalten des genannten Ereignisses nuzte ich zur Vorsicht falls weiterer Code zugefügt werden sollte!

Gruss Nighty

Answer 3

hi Peter :-)

Für einen Rücksprung bietet sich folgendes an!
Eine Selection deiner Wunschzelle,gültig in allen Tabellen

Einzufügen
Alt + F11/Projektexplorer/DeineArbeitsMappe

Die 2 steht für Spalte B
Die 1 für Zeile 1
gültig in allen Blättern

Zu korrigieren wären der Name Tabelle1
und deine Wunschzelle mit dem jeweiligen Index,statt 2 und 1!

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column = 2 And Target.Row = 1 Then
Application.EnableEvents = False
Worksheets("Tabelle1").Activate
Application.EnableEvents = True
End If
End Sub

Answer 4

hi peter :-)

das erste makro korrigiert!
das leere zellen keinen fehler verursachen!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Cells(Target.Row, Target.Column) <> "" Then
Application.EnableEvents = False
Worksheets("" & Target).Activate
Application.EnableEvents = True
End If
End Sub

gruss Nighty

Answer 5

Hallo Nighty,

vielen Dank für die superschnelle Hilfe. Ich wünsche noch einen schönen Abend.

Gruss

Peter

Answer 6

Hallo Nighty,

wenn Du gestattest, habe ich noch eine kurze Frage. Und zwar habe ich in Zeile 1 und 2 Spaltenüberschriften. Demnach müsste das Makro erst ab Zeile 3 für die Spalte C anfangen zu arbeiten. Momentan bekommen ich noch einen Fehler, wenn ich auf Zelle C1 oder C2 drücke.

Vielen Dank.

Gruss

Peter

Answer 7

Hi Peter !

Wie gewünscht!

Gruß Nighty

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 And Target.Row > 2 And Cells(Target.Row, Target.Column) <> "" Then
Application.EnableEvents = False
Worksheets("" & Target).Activate
Application.EnableEvents = True
End If
End Sub

Der Code wirkt nun auf Spalte C (Index 3)
und ab Zeile 3 (Target.Row > 2)

Answer 8

Hi Peter :-)

Testphasen sind meine Archillesverse O_o

Ich denke oftmals an zu viele dinge und warte dann doch lieber erst ab *hihi*

Daher erwartete ich schon eine erneute Anfrage :-)

Gruß Nighty

Answer 9

Super Nighty,

tausend Dank.

Gruss

Peter