Kat, I don't remember where I got this code from. But it should do what you
want, modified it to fit your needs
Sub WorksheetNamesWithHyperLink()
'will add a sheet called worksheetNamesTable
'put all the worksheet names in column A, with hyperlinks
'and put the valve of C2 in all sheets in column B
Dim iRow As Integer, iColumn As Integer
Dim i As Integer, x As Integer, iWorksheets As Integer
Dim objOutputArea As Object
Dim StrTableName As String, StrWorkSheetName As String
StrTableName = "WorksheetNamesTable"
'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Worksheets(x).Name) = UCase(StrTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False 'turn warning messages
off
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True 'turn warning messages
on
'Exit Sub
End If
Next
'Add new worksheet at end of workbook
' where results will be located
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.Name = StrTableName
ActiveWorkbook.ActiveSheet.Range("A1").Value = "Worksheet Names"
ActiveWorkbook.ActiveSheet.Range("B1").Value = "Value in Cell C2"
'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count
'Initialize row and column counts for putting info into StrTableName
sheet
iRow = 1
iColumn = 0
Set objOutputArea = ActiveWorkbook.Sheets(StrTableName).Range("A1")
'Check Sheet names
For x = 1 To iWorksheets
Sheets(x).Activate
StrWorkSheetName = ActiveSheet.Name
'put information into StrTableName worksheet
With objOutputArea
.Offset(iRow, iColumn) = " " & StrWorkSheetName
.Offset(iRow, iColumn + 1) = "=" & StrWorkSheetName & "!C2"
'create hyperlink
ActiveSheet.Hyperlinks.Add anchor:=objOutputArea.Offset(iRow,
iColumn), _
Address:="", _
SubAddress:=Chr(39) & StrWorkSheetName & Chr(39) & "!A1"
iRow = iRow + 1
End With
Next x
'format StrTableName worksheet
Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1,B1").Font.Bold = True
Columns("A:B").EntireColumn.AutoFit
End Sub
