Private Sub CommandButton1_Click()
Create_TOC
End Sub
'The code is as:-
Sub Create_TOC()
Dim wbBook As Workbook
Dim wsTOC As Worksheet
Dim wsSheet As Worksheet
Dim InRowNum As Long
Dim InPrintPageNum As Long
Dim InSheetNum As Long
Set wbBook = ActiveWorkbook
With Application
'To stop display while updating
.DisplayAlerts = False
.ScreenUpdating = False
End With
On Error Resume Next
With wbBook
.Worksheets("TOC").Activate
.ActiveSheet.Range("A2", "B200") = "" 'Clears and sets the range, change if need to
End With
On Error GoTo 0
Set wsTOC = wbBook.ActiveSheet
With wsTOC
'To name headers in A1 B!1
With .Range("A1:B1")
.Value = VBA.Array("Table of Contents", "Sheet Num - Num of Pages") 'Sheet Num - Num of Pages, this allows you to see the number of
'print pages and tidy up sheet if need to
.Font.Bold = True
.Font.Color = vbRed
End With
End With
InRowNum = 2
InSheetNum = 1
'Work way through the worksheets in the workbook and create
'sheetnames, hyperlink and sheet number & write the number
'of pages to be printed for each sheet on the TOC sheet.
For Each wsSheet In wbBook.Worksheets
If wsSheet.Name <> wsTOC.Name Then
wsSheet.Activate
With wsTOC
'@ used to format tab names to text this is for sheets that make contain the = symbol
.Cells(InRowNum, 1).NumberFormat = "@"
.Hyperlinks.Add .Cells(InRowNum, 1), "", _
SubAddress:="'" & wsSheet.Name & "'!A1", _
TextToDisplay:="'" & wsSheet.Name
InPrintPageNum = wsSheet.PageSetup.Pages().Count
.Cells(InRowNum, 2).Value = "'" & InSheetNum & "-" & InPrintPageNum
End With
InRowNum = InRowNum + 1
InSheetNum = InSheetNum + 1
End If
Next wsSheet
wsTOC.Activate
wsTOC.Columns("A:B").EntireColumn.AutoFit
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
