ExcelBanter - on your main page click on the worksheet name and be taken to it

This will create a Table of Contents page with hyperlinks to each worksheet.
Hope it helps.
Sincerely,
Gary Brown

'/=============================================/
' Sub Purpose:
' Create a separate worksheet with the name of each sheet
' in the workbook as a hyperlink to that sheet -
' i.e. a Table Of Contents
' 07/25/2000 - allow for chart sheets
' 08/11/2005 - add Protect/Unprotect information
'
'
Public Sub TableOfContents()
Dim blnContinue As Boolean
Dim iRow As Integer, iColumn As Integer
Dim i As Integer, x As Integer, iSheets As Integer
Dim iType As Integer
Dim objOutputArea As Object
Dim strTableName As String, strSheetName As String
Dim strTypeName As String
Dim varAnswer As Variant

On Error GoTo err_Sub

strTableName = "Table of Contents1"
blnContinue = True

'check for an active workbook
If ActiveWorkbook Is Nothing Then
Workbooks.Add
End If

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'Check for duplicate Sheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Sheets(x).name) = UCase(strTableName) Then
blnContinue = False
Sheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
varAnswer = _
MsgBox("Do you wish to delete the current <<< " & _
strTableName & " worksheet?", _
vbInformation + vbYesNoCancel + vbDefaultButton1, _
"Warning..." & strTableName & " already exists...")
If varAnswer = vbYes Then
blnContinue = True
'turn warning messages off
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'turn warning messages on
Application.DisplayAlerts = True
End If
Exit For
End If
Next

If blnContinue = True Then
'Add new sheet at end of workbook
' where results will be located
Sheets.Add.Move Befo=Sheets(1)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.name = strTableName
ActiveWorkbook.ActiveSheet.Range("A1").value = _
"Worksheet (hyperlink)"
ActiveWorkbook.ActiveSheet.Range("B1").value = _
"Visible / Hidden"
ActiveWorkbook.ActiveSheet.Range("C1").value = _
"Prot / Un / Tab Color"
ActiveWorkbook.ActiveSheet.Range("D1").value = _
" Notes: "
ActiveWorkbook.ActiveSheet.Range("E1").value = _
" Type: "

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'Initialize row and column counts for putting
' info into StrTableName sheet
iRow = 1
iColumn = 0

Set objOutputArea = _
ActiveWorkbook.Sheets(strTableName).Range("A1")

'Check Sheet names
For x = 1 To iSheets
strSheetName = Sheets(x).name
'put information into StrTableName worksheet
With objOutputArea
If strSheetName < strTableName Then
.Offset(iRow, iColumn) = " " & strSheetName
If UCase(TypeName(Sheets(x))) < "CHART" Then
Sheets(x).Hyperlinks.Add _
Anchor:=objOutputArea.Offset(iRow, _
iColumn), _
Address:="", SubAddress:=Chr(39) & _
strSheetName & Chr(39) & "!A1"
End If

If Application.VERSION = 11 Then
.Offset(iRow, iColumn + 2).Interior.ColorIndex = _
Sheets(x).Tab.ColorIndex
End If

Select Case Sheets(x).Visible
Case xlSheetVisible
.Offset(iRow, iColumn + 1) = " Visible"
.Offset(iRow, iColumn).Font.Bold = True
.Offset(iRow, iColumn + 1).Font.Bold = True
Case xlSheetHidden
.Offset(iRow, iColumn + 1) = " Hidden"
Case xlSheetVeryHidden
.Offset(iRow, iColumn + 1) = " Very Hidden"
End Select

If Sheets(x).ProtectContents = True Then
.Offset(iRow, iColumn + 2) = " P"
Else
.Offset(iRow, iColumn + 2) = " U"
End If

iType = Sheets(x).Type
strTypeName = TypeName(Sheets(x))
.Offset(iRow, iColumn + 4) = _
fncWorksheetType(iType, strTypeName)

iRow = iRow + 1

End If
End With
Next x

Sheets(strTableName).Activate

'make comment
Range("C1").AddComment

With Range("C1").Comment
.Visible = False

.Text Text:= _
"Protected / Unprotected Worksheet / Tab Color"

End With

'format worksheet
Range("A:E").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.name = "Tahoma"
'.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
'.ColorIndex = xlAutomatic
End With

Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Font.Bold = True
Columns("A:E").EntireColumn.AutoFit

Range("A1:E1").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Underline = xlUnderlineStyleSingle
End With

Range("B1").Select
With ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Bold"
End With
With ActiveCell.Characters(Start:=8, Length:=9).Font
.FontStyle = "Regular"
End With

Columns("A:E").EntireColumn.AutoFit
Range("A1:E1").Font.Underline = _
xlUnderlineStyleSingleAccounting

Range("B:B").HorizontalAlignment = xlCenter

Range("C1").WrapText = True
Columns("C:C").HorizontalAlignment = xlCenter
Rows("1:1").RowHeight = 100
Columns("C:C").ColumnWidth = 9.75
Rows("1:1").EntireRow.AutoFit

Range("D1").HorizontalAlignment = xlLeft
Columns("D:D").ColumnWidth = 65

'format print options
On Error Resume Next

Call PageSetupXL4( _
CenterHead:="&B" & "&16&U&F - [&A]", _
CenterFoot:="Page &P of &N", _
LeftMarginInches:=0.75, _
RightMarginInches:=0.75, _
TopMarginInches:=1, _
BottomMarginInches:=0.75, _
HeaderMarginInches:=0.5, _
FooterMarginInches:=0.5, _
PrintGridlines:=True, _
Orientation:=xlLandscape, _
CenterHorizontally:=True, _
Zoom:=True, _
Order:=xlOverThenDown)

With ActiveSheet.PageSetup
.PrintArea = "$A:$D"
.FitToPagesWide = 1
.FitToPagesTall = False
If .PrintTitleRows = "" Then
.PrintTitleRows = "$1:$1"
End If
If .PaperSize < xlPaperLetter And _
.PaperSize < xlPaperLegal Then
.PaperSize = xlPaperLetter '1
End If
End With

Range("A1").Select

Selection.AutoFilter

Application.Dialogs(xlDialogWorkbookName).Show
End If

exit_Sub:
On Error Resume Next
Application.DisplayAlerts = True
Exit Sub

err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: TableOfContents - " & _
"Module: Mod_Table_Of_Contents - " & Now()
If Err.Number = 1004 Then
MsgBox "The Workbook (" & Chr(34) & _
Application.ActiveWorkbook.name & _
Chr(34) & ") is protected. A " & _
"'Table of Contents' worksheet could not be " & _
"created. Please unprotect the " & _
"Workbook and try again.", _
vbInformation + vbOKOnly, "Warning..."
End If
If Err.Number = 438 Then
iType = 9999
Resume Next
End If
GoTo exit_Sub

End Sub
'/=============================================/
' Function Purpose: return the worksheet type
'
Public Function fncWorksheetType(iType As Integer, _
strTypeName As String) As String

Dim strResult As String

On Error GoTo err_Function

Select Case strTypeName
Case "Worksheet"
Select Case iType
Case xlWorksheet ' -4167
strResult = strTypeName
Case xlExcel4MacroSheet ' 3
strResult = "Excel4 Macro"
Case xlExcel4IntlMacroSheet ' 4
strResult = "Excel4 Intl Macro"
Case Else
strResult = "Unknown"
End Select
Case "Chart"
strResult = strTypeName
Case "DialogSheet"
strResult = strTypeName
Case Else
strResult = "Unknown"
End Select

fncWorksheetType = strResult

exit_Function:
On Error Resume Next
Exit Function

err_Function:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Function: fncWorksheetType - " & _
"Module: Mod_Table_Of_Contents - " & Now()
fncWorksheetType = "Unknown"
GoTo exit_Function

End Function
'/=============================================/