Add a sheet and create a sheet list.

CreatingSheetIndex.bas

Sub CreatingTOCSheet()

Dim bkTarget As Workbook      'subject workbook
Dim shTOC As Worksheet    'TOC worksheet
Dim sh As Worksheet    'worksheets to be listed
Dim flag As Boolean     'boolean to check if a new worksheet is necessary
Dim finalRow As Integer
Dim i As Integer
Dim msgAnswer As VBA.VbMsgBoxResult  'store the answer of the message box
Dim shName As String
Dim tocRange As Integer

Set bkTarget = ActiveWorkbook
Application.ScreenUpdating = False

With bkTarget

    'Set the worksheet named "TOC" as "TOC" sheet.
    'If there isn't, add a new sheet.
    For Each sh In .Worksheets
        shName = sh.Name
        If shName = "TOC" Then flag = True
    Next sh

    If flag = True Then
        'If the "TOC" sheet already exists, ask if it is okay to overwrite the list.
        msgAnswer = VBA.MsgBox("You already have TOC sheet." & vbNewLine & _
                                "The TOC could be overwritten. " & vbNewLine & _
                                "Would you like to continue?", vbOKCancel + vbDefaultButton1)
        If msgAnswer = vbCancel Then Exit Sub
    Else
        .Worksheets.Add(before:=Worksheets(1)).Name = "TOC"
    End If

    Set shTOC = .Worksheets("TOC")

End With

'Clear cell value & format
With shTOC.Cells
    .Clear
    .VerticalAlignment = xlCenter
    .Font.Color = 2500134
End With

'List up the visible sheets on TOC sheet
For i = 2 To bkTarget.Worksheets.Count
    Set sh = bkTarget.Worksheets(i)
    shName = sh.Name
    If ActiveSheet.Name <> shName Then
        If sh.Visible = xlSheetVisible Then
        ActiveSheet.Hyperlinks.Add _
            Anchor:=shTOC.Cells(i + 3, 3), _
            Address:="", _
            SubAddress:="'" & shName & "'!A1", _
            TextToDisplay:=shName
        End If 'sheet is visible
    End If ' sheet is not activesheet
Next i

'---------------
'Format TOC sheet
'---------------

'Format sheet title
With shTOC.Cells(2, 2)
    .Value = "Table of Contents"
    .Font.Size = 16
    .Font.Bold = True
End With

'Format table headers
With shTOC.Rows(4)
    .Font.Size = 8
    .Font.Bold = True
    .VerticalAlignment = xlBottom
End With
    
shTOC.Columns("A:B").ColumnWidth = 3
shTOC.Columns("C:D").IndentLevel = 1
        
finalRow = shTOC.Cells(shTOC.Rows.Count, 3).End(xlUp).Row

If finalRow <= 5 Then
   tocRange = 1
Else
   tocRange = finalRow - 4
End If

With shTOC.Range("C5").CurrentRegion.Resize(tocRange, 2)
'Table lines
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With
End With

'Add the headers
With shTOC
    .Cells(4, 3).Value = "Sheet Name"
    .Cells(4, 4).Value = "Remarks"
End With
  
  
With shTOC
    'Autofit the column width
    If .Columns("C").ColumnWidth > 25 Then
        .Columns("C").AutoFit
    Else
        .Columns("C").ColumnWidth = 25
    End If
    .Columns("D").ColumnWidth = 40
    .Columns(5).ColumnWidth = 3
    
    'Set row height
    .Rows.RowHeight = 18
    .Rows(2).RowHeight = 25 'title row
End With

With shTOC.Range("B3:C3")
    .Merge
    .Font.Size = 8
    .Font.Italic = True
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlTop
    .Value = VBA.DateTime.Date
    .NumberFormat = """(as of ""dd mmmm yyyy"")"""
End With
    
'Page setup
With shTOC.PageSetup
    .PrintArea = Range(Cells(2, 2), Cells(finalRow, 5)).Address
    .Orientation = xlPortrait
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With

For Each sh In ActiveWorkbook.Worksheets
    sh.Activate
    sh.Range("A1").Select
    With ActiveWindow
        .ScrollColumn = 1
        .ScrollRow = 1
        .View = xlNormalView
        .DisplayGridlines = False
    End With
Next sh

shTOC.Select

Application.ScreenUpdating = True
MsgBox ("DONE")

End Sub