Sahanya

Gerade bei umfangreichen Excel-Dokumenten kann es schnell passieren, dass man bei einer hohen Anzahl von Tabellenblättern den Ãœberblick verliert. Ein Makro kann da Abhilfe schaffen. Es erstellt ein neues Tabellenblatt mit dem Namen „Index” als erstes Tabellenblatt und listet dort die Namen der anderen Tabellenblätter auf. Diese sind verlinkt, so dass man mit einem Klick auf dem gewünschten Tabellenblatt landet. Auf den einzelnen Tabellenblättern wird ein Link zum Index-Tabellenblatt eingefügt. Hier sollte man allerdings aufpassen, denn dieser wird (hier im Beispiel) in die Zelle „H1” eingefügt und überschreibt somit den ursprünglichen Inhalt. Man sollte dies also evtl. anpassen. Das Makro selbst habe ich bei Lockergnome gefunden und erweitert um die Mitteilung, dass bereits ein Index existiert. Außerdem habe ich das ganze ergänzt um ein Makro, das den Index und sämtliche Links dorthin wieder löscht.

Sub Index()
Dim wSheet As Worksheet
Dim M As Long
M = 1

On Error Resume Next
If Worksheets(1).Name = "Index" Then
MsgBox "Ein Index besteht bereits."
Else
Worksheets.Add Before:=ActiveWorkbook.Worksheets(1)
Worksheets(1).Name = "Index"
End If

With ActiveWorkbook.Worksheets(1)
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With

For Each wSheet In Worksheets
If wSheet.Name <> ActiveWorkbook.Worksheets(1).Name Then
M = M + 1
With wSheet
.Range("H1").Name = "Start" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("H1"), Address:="", SubAddress:="Index", TextToDisplay:="Zurück zum Index"
End With
ActiveWorkbook.Worksheets(1).Hyperlinks.Add Anchor:=ActiveWorkbook.Worksheets(1).Cells(M, 1), Address:="", _
SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub

Wenn man diesen Index nicht mehr benötigt, kann man ihn mit folgendem Makro wieder löschen:

Sub Index_entfernen()
Dim wSheet As Worksheet

On Error GoTo Fehlermeldung
Application.DisplayAlerts = False 'Unterdrückt Sicherheitsabfrage
Worksheets("Index").Delete
Application.DisplayAlerts = True

For Each wSheet In ActiveWorkbook.Worksheets
wSheet.Activate
Range("H1").Select
Selection.ClearContents
Next wSheet

Exit Sub
Fehlermeldung:
MsgBox ("Es gibt kein Index.")

End Sub