create hyperlink cell in excel using VB

[Guest]

I have created a summary sheet from cells in other sheets. I have also
included the sheet name in a cell on each row of data in the summary (extract
below). Does any one know how I can make the Cell with the sheet name a
hyperlink to that sheet using Visual Basic?

Greatful for any help!

For Each sh In Worksheets

If Left(sh.Name, 4) = "TEST" Then ' Only use those where the worksheet
name starts with TEST
Worksheets("Summary").Cells(CellnumberTo, CellLetterTo) = sh.Name
CellLetterTo = CellLetterTo + 1
Worksheets("Summary").Cells(CellnumberTo, CellLetterTo) =
sh.Range(TestDescription).Value
CellLetterTo = CellLetterTo + 1 etc

 

[Jim Cone]

With Worksheets("Summary")
.Cells(CellnumberTo, CellLetterTo).Value = sh.Name
.Hyperlinks.Add anchor:=.Cells(CellnumberTo, CellLetterTo), Address:="", _
SubAddress:="'" & sh.Name & "'!A1"
End With
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware




"Haldane" <[email protected]>
wrote in message
I have created a summary sheet from cells in other sheets. I have also
included the sheet name in a cell on each row of data in the summary (extract
below). Does any one know how I can make the Cell with the sheet name a
hyperlink to that sheet using Visual Basic?
Greatful for any help!

For Each sh In Worksheets

If Left(sh.Name, 4) = "TEST" Then ' Only use those where the worksheet
name starts with TEST
Worksheets("Summary").Cells(CellnumberTo, CellLetterTo) = sh.Name
CellLetterTo = CellLetterTo + 1
Worksheets("Summary").Cells(CellnumberTo, CellLetterTo) =
sh.Range(TestDescription).Value
CellLetterTo = CellLetterTo + 1 etc

 

[Mike Fogleman]

Something like this:

Sub Hyp_Add()
Dim sh As Worksheet
Dim CellnumberTo As Long
Dim CellLetterTo As Integer

For Each sh In Worksheets
If Left(sh.Name, 4) = "TEST" Then ' Only use those where the worksheet
'name starts with TEST
Worksheets("Summary").Hyperlinks.Add Anchor:= _
Cells(CellnumberTo, CellLetterTo), Address:="", _
SubAddress:=sh.Name & "!A1", _
TextToDisplay:=sh.Name

CellLetterTo = CellLetterTo + 1
Worksheets("Summary").Cells(CellnumberTo, CellLetterTo) = _
sh.Range(TestDescription).Value
CellLetterTo = CellLetterTo + 1 'etc
End If
Next
End Sub


Mike F

 

[Guest]

Thanks Jim that worked first time -