Help with using Hyperlinks in VBA

[mwc360]

Hi,

I have a workbook where the first sheet (Project Schedule) serves as a sort of table of contents for all the individual project notes sheets. As I create a new row in Project Schedule I give it a code to indicate which project it refers to ( i.e. P002, P003, P004 etc.). The code below is run by a button in which the user would select the desired project ID (P030, P034, etc.) and then it creates a new sheet from a template (Notes Template), renames the title of the sheet to the project ID, renames the sheet based on the sheet title, copy and pastes the description to the sheet from the table of contents. I then want to hyperlink the Project ID on the table of contents to the identically named sheet (project notes). Everything works exactly how I want up til hyperlinking the Project ID to the sheet which contains the project notes. I hope this makes sense.

I want the subaddress to be the sheet that was just created and the TextToDisplay to be name of the sheet it is linking to or the value of the current cell that contains the hyperlink.

Thanks!

Sub Macro10()
'
' Macro10 Macro
'

'
    ActiveWorkbook.Save
    Sheets("Notes Template").Select
    Sheets("Notes Template").Copy After:=Sheets(Sheets.Count)
    Sheets("Project Schedule").Select
    ActiveCell.Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    Range("$B$2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets(Sheets.Count).Name = ActiveSheet.Range("$B$2")
    Sheets("Project Schedule").Select
    ActiveCell.Offset(0, 4).Range("A1").Select
    Selection.Copy
    Sheets(Sheets.Count).Select
    ActiveCell.Offset(2, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    'HYPERLINK => THIS IS WHAT I NEED HELP WITH
    Sheets("Project Schedule").Select
    ActiveCell.Offset(0, -4).Range("A1").Select
   [COLOR=#b22222] ActiveSelection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Sheets(Sheets.Count).Name & "!A1", TextToDisplay:=ActiveSelection.Value[/COLOR]
End Sub