Hi,
I am using the following code to create a table of contents but I don't want to use every sheet in the book. The ones at the back section are for data storage only.
I also don't want to include the first data input page.
Thanks![]()
Sub CreateTableOfContents() ' Determine if there is already a Table of Contents Dim WST As Worksheet On Error Resume Next Set WST = Worksheets("INDEX") If Not Err = 0 Then ' The Table of contents doesn't exist. Add it Set WST = Worksheets.Add(Before:=Worksheets(1)) WST.Name = "INDEX" End If On Error GoTo 0 ' Set up the table of contents page WST.[A15] = "CONTENTS" WST.[d15] = "PAGE" WST.Range("A1:B1").ColumnWidth = Array(36, 12) TOCRow = 17 PageCount = -1 ' Do a print preview on all sheets so Excel calcs page breaks Msg = "Excel needs to do a print preview to calculate the number of pages. " Msg = Msg & "Please dismiss the print preview by clicking close." MsgBox Msg ActiveWindow.SelectedSheets.PrintPreview ' Loop through each sheet, collecting TOC information ' Loop through each sheet, collecting TOC information For Each S In Worksheets If S.Visible = -1 Then S.Select ' Use any one of the following 3 lines ThisName = Range("A6").Value 'ThisName = ActiveSheet.PageSetup.LeftHeader HPages = ActiveSheet.HPageBreaks.Count + 1 VPages = ActiveSheet.VPageBreaks.Count + 1 ThisPages = HPages * VPages ' Enter info about this sheet on TOC Sheets("INDEX").Select Range("A" & TOCRow).Value = ThisName Range("D" & TOCRow).NumberFormat = "@" If ThisPages = 1 Then Range("D" & TOCRow).Value = PageCount + 1 & " " Else Range("D" & TOCRow).Value = PageCount + 1 '& " - " & PageCount + ThisPages End If PageCount = PageCount + ThisPages TOCRow = TOCRow + 2 End If Next S End Sub
Bookmarks