Hi Experts,
Please help on the following code, where it is wrong and please correct
Option Explicit
Sub Create_TOC()
Dim wbBook As Workbook
Dim wsActive As Worksheet
Dim wsSheet As Worksheet
Dim InRow As Long
Dim InPages As Long
Dim InCount As Long
Set wbBook - ActiveWorkbook
With Application
.DisplayAlerts = False
.SecreenUpdating = False
End With
'If the TOC sheet already exist delete it and add a new
'worksheet.
On Error Resume Next
With wbBook
.Worksheets ("TOC") .Delete
.Worksheets.Add Before:=.Worksheets(1)
End With
On Error GoTo 0
Set wsActive = wbBook.ActiveSheet
With wsActive
.Name = "TOC"
With .Range("A1:B1")
.Value = VBA.Arrary("Table of Content", "Sheet # - # of Pages")
.Font.Bold = True
End With
End With
1 nRow = 2
1 nCount = 1
'Iterate through the worksheets in the workbook and create
'sheetnames, add hyperlink and count & write the running number
'of pages to be printed for each sheet on the TOC sheet.
For Each wsSheet In wbBook.Worksheets
If wsSheet.Name <> wsActive.Name Then
wsSheet.Activate
With wsActive
.Hyperlinks.Add .Cells(1nRow, 1), "", _
SubAddress:="'" & wsSheet,Name & "'!A1",_
TextToDisplay:=wsSheet.Name
1nPages = wsSheet.PageSetup.Pages () .Count
.Cells(1nRow, 2) .Value = "'" & InCount & "-" & 1nPages
End With
1nRow = 1nRow + 1
1nCount = 1nCount +1
End If
Next wsSheet
wsActive.Activate
wsActive.Columns ("A:B") .EntireColumn.AutoFit
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Thanks
Rohan
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
