create an Index sheet for all the worksheets within the workbook,Creating a Table of Contents

create an Index sheet for all the worksheets within the workbook

In this example there is worksheet named 'HOME' where you create a list of worksheets. 

 Sub ListSheets()  
 ' Description: This procedure creates worksheet List  
 '        and corresponding GoTo hyperlinks.  
 '--  
 Const cstrProcedure = "ListSheets"  
   On Error GoTo HandleError  
   Dim wks As Worksheet  
   Dim strSheetName As String  
   Dim i As Integer, j As Integer, n As Integer  
   Application.ScreenUpdating = False  
   With ThisWorkbook  
     n = .Worksheets.Count  
     ' Customize Start Reference  
     Set c = .Worksheets("Home").Range("B6")        ' Start List From HOME!B6  
     c.CurrentRegion.Offset(1, 0).ClearContents  
     i = 0: j = 0  
     For Each wks In .Worksheets  
       i = i + 1  
       ''' If Sheet Name <> predefined sheet names thenh update List by sheet name  
       If (wks.Name <> "HOME") Then  
         j = j + 1  
         strSheetName = wks.Name  
         'Update Sheet Name  
         c.Value = strSheetName  
         Application.StatusBar = i & " of " & n & _  
             "Creating 'GoTo' Hyperlink to page '" & strSheetName & "'..."  
         'Create Hyperlink GoTo Sheet 'A1'  
         .Worksheets("Home").Hyperlinks.Add _  
             Anchor:=c, _  
             Address:="", _  
             SubAddress:="'" & strSheetName & "'!A1", _  
             TextToDisplay:=j & ". " & strSheetName  
           ' Insert Status:  
           c.Offset(0, 1).value = wks.Range("H43").Value  
           ''' Optional:  
         ''' On each Worksheet create Hyperlink GoTo HOME Page  
         wks.Range("H1").Value = "Go HOME"  
         'Range("H1").FormulaR1C1 = "Go Home"  
         wks.Hyperlinks.Add _  
             Anchor:=wks.Range("H1"), _  
             Address:="", _  
             SubAddress:="HOME!A1", _  
             TextToDisplay:="Go Home"  
           '''---  
         Set c = c.Offset(1, 0)  
       End If  
       '--  
     Next wks  
   End With  
   MsgBox "Worksheet List with corresponding Hyperlinks" & vbLf & _  
       "created successfully.", vbInformation, "List Index"  
 HandleExit:  
   Application.ScreenUpdating = True  
   Application.StatusBar = False  
   Exit Sub  
 HandleError:  
   MsgBox "Module: '" & cstrModule & "', Procedure: '" & cstrProcedure & "'" & vbLf & _  
       "Error: (" & Err.Number & ")" & vbLf & Err.Description  
   Resume HandleExit  
 End Sub  
 '--