Macro to copy content from same cell on each WS into new column?

[oysterriver]

I have a report that comes to me with the worksheet names already generated from the contents of cell A3 on each WS. Unfortunately, the majority of them exceed 31 characters, so the names are so similar as to be useless:


2011 YTD Total Product Replacemen_1

2011 YTD Total Product Replacemen_2

2011 YTD Total Product Replacemen_3

2011 YTD Total Product Replacemen_4


I need to create a directory that will list the complete title of each worksheet and then create a hyperlink to it. My plan was to add a master worksheet where Column A pulls in the contents of cell A3 from each worksheet. That is, on the master worksheet:


Cell a2 = text from worksheet 2, cell a3

Cell a3 = text from worksheet 3, cell a3

Cell a4 = text from worksheet 4, cell a3

…through all 500 worksheets in the workbook.


It sounds like the sort of thing I should be able to do with a macro, but I know only enough VBA to make me dangerous. If anyone could point me in the right direction, I’d be grateful.

 

[Luke M]

Saw this on one of Debra's posts. Credits to:

Sample code posted by Andrew

http://blog.contextures.com/archives/2008/12/17/create-a-table-of-contents-in-excel/#comment-1267

I've modified Andrew's code a little bit to check if Table Of Contents is already in place or not.

[pre]

Sub CreateTableOfContents()
'Below is a macro that creates a Table of Contents sheet and
'puts a hyperlink to every sheet that isn’t hidden and is not the current sheet.
'The links do not work for sheets that are graphs and I do not know
'how to either make them work or test that they are graphs and not include them.

Dim shtName As String
Dim shtLink As String
Dim rowNum As Integer
Dim newSht As Worksheet
Dim i As Long
Dim IndexExists As Boolean

For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Table Of Contents" Then
IndexExists = True
End If
Next

If IndexExists Then
Set newSht = Worksheets("Table Of Contents")
Else
Set newSht = Sheets.Add
newSht.Name = "Table Of Contents"
newSht.Select
End If

'Where does index start?
newSht.Range("A1").Value = "Table of Contents"
rowNum = 2

For i = 1 To Sheets.Count
'Does not create a link if the Sheet isn’t visible or the sheet is the current sheet
If Sheets(i).Visible = True And Sheets(i).Name <> ActiveSheet.Name And IsSheet(Sheets(i).Name) Then
shtName = Sheets(i).Name
shtLink = "'" & shtName & "'!A1"
newSht.Cells(rowNum, 1).Select
'inserts the hyperlink to the sheet and cell A1
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
shtLink, TextToDisplay:=shtName
rowNum = rowNum + 1
End If
Next i

End Sub

Public Function IsSheet(cName As String) As Boolean

Dim tmpChart As Chart

On Error Resume Next
Set tmpChart = Charts(cName)
On Error GoTo 0
IsSheet = IIf(tmpChart Is Nothing, True, False)

End Function

[/pre]

 

[oysterriver]

Thanks so much, Luke. It's almost there. The only thing I need to tweak is the name. This gives the name of each sheet, rather than the contents of cell A3 from each sheet. I'll play around and let you know how I make out. Thanks for giving me a jumping off point!

 

[Luke M]

This line:

[pre]

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
shtLink, TextToDisplay:=shtName
Should be changed to:

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
shtLink, TextToDisplay:=Worksheet(shtName).Range("A3").Value

[/pre]

 

[oysterriver]

Brilliant! That did the trick. I hit a minor snag and got a compile error, so I changed Worksheet to Worksheets & it worked a treat. Thanks a million, Luke.