Sub IndexSheetNames()

Dim xWs As Worksheet
On Error Resume Next

Application.DisplayAlerts = False


' First sort the sheets
Dim SortAnswer As Integer
SortAnswer = MsgBox("Do you want to sort the sheets first?", vbYesNo + vbQuestion, "Sort?")
If SortAnswer = vbYes Then
Dim sCount, i, j As Integer
 sCount = Worksheets.Count
 If sCount = 1 Then Exit Sub
 For i = 1 To sCount - 1
 For j = i + 1 To sCount
 If Worksheets(j).Name < Worksheets(i).Name Then
 Worksheets(j).Move before:=Worksheets(i)
 End If
 Next j
 Next i
End If

Dim OurName As String

' remove the code between the markers if you want to use a specific name without the prompt
' **********************************************************************

OurName = InputBox("Name of Index sheet?" & vbCrLf _
    & vbCrLf & "(Null entry or Cancel will terminate)")

If OurName = "" Or OurName = vbNullString Then
    GoTo LeaveIt
End If
' **********************************************************************

' Now add the name you want to use and uncomment the following statement
'OurName = "$$$INDEX"

xTitleId = OurName
Application.Sheets(xTitleId).Delete ' delete any existing sheet of our name
Application.Sheets.Add Application.Sheets(1)

Set xWs = Application.ActiveSheet

xWs.Name = xTitleId
xWs.Range("A1") = "Sheet Name"
xWs.Range("B1") = "Comments                       "

' Add any other columns you may need in the index in here

' Center headings, add borders and color ithe headings

xWs.Range("A1:B1").HorizontalAlignment = xlCenter
xWs.Range("A1:B1").Borders.LineStyle = xlContinuous
xWs.Range("A1:B1").Interior.ColorIndex = 15

k = 3
x = Application.Sheets.Count + 2
For i = 3 To x
    If Left(Application.Sheets(i - 1).Name, 1) = "$" Then

'   Ignore sheets with names starting with "$"

    Else
        xWs.Range("A" & (k - 1)) = Application.Sheets(i - 1).Name
        xWs.Range("A" & (k - 1), "B" & (k - 1)).Borders.LineStyle = xlContinuous
        k = k + 1
    End If
Next i

ActiveSheet.PageSetup.CenterHeader = "&C&24&U&B Index of Workbook " & ThisWorkbook.Name
ActiveSheet.PageSetup.RightFooter = Format(Now, "MMMM DD, YYYY HH:MM:SS")
ActiveSheet.PageSetup.CenterFooter = "Page &P of &N"
ActiveSheet.PageSetup.CenterHorizontally = True
Application.DisplayAlerts = True

Columns("A:B").Select
Selection.EntireColumn.AutoFit  ' autofit headings
'Columns("A:B").Deselect
LeaveIt:

End Sub