Add Shape With Hyperlink To Another Sheet

Here's a way to add a shape during run time and assign a hyperlink to another sheet.

Code:

---

Sub AddShapeLink()

    Dim strSheet As String
    Dim wks As Worksheet
   
    strSheet = "Sheet1" 'You can give the name of your map sheet here
    Set wks = Worksheets(strSheet)
    wks.Shapes.AddShape(msoShapeRectangle, 20, 20, 20, 10).Name = Sheets.Count + 1 'Adding a new shape and giving it a name. One can give any name (assuming it doesn't exist in the sheet already)
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = Sheets.Count + 1 'We are adding a new sheet here, but one can use an existing sheet too
    wks.Hyperlinks.Add wks.Shapes("" & Sheets.Count & ""), "", "'" & Sheets(Sheets.Count).Name & "'!A1" 'The hyperlink given to the sheet range A1
   
    Set wks = Nothing
    strSheet = vbNullString
   
End Sub

---