***Place In ThisWorkbook Module*** 
 
Private Sub Workbook_Activate() 
    CreateMenu 
End Sub 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    DeleteMenu 
End Sub 
 
Private Sub Workbook_Deactivate() 
    DeleteMenu 
End Sub 
 
Private Sub Workbook_Open() 
    CreateMenu 
End Sub 
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
    DeleteMenu 
    CreateMenu 
End Sub 
 
***Place In a standard module*** 
 
Option Explicit 
 
Option Private Module 'prevent menu macros appearing under Tools|Macros
 
Sub CreateMenu() 
    Dim MenuObject As CommandBarPopup, MenuItem As Object 
    Dim SubMenuItem As CommandBarButton, Sh As Worksheet, i As Long 
     
     ' Make sure the menus aren't duplicated
    Call DeleteMenu 
     
     ' Add the top-level menu to the Worksheet CommandBar
    Set MenuObject = Application.CommandBars(1). _ 
    Controls.Add(Type:=msoControlPopup, Temporary:=True) 
     'Name of top level menu. Remember to also change caption in DeleteMenu macro
    MenuObject.Caption = "&My Menu" 
     
     'Add 1st menu item
    Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup) 
    MenuItem.Caption = "Go To Sheet" 
     
     'Add sub menu items to 1st menu
    For Each Sh In ThisWorkbook.Sheets 
        i = i + 1 
        Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton) 
        SubMenuItem.Caption = Sh.Name 
        SubMenuItem.OnAction = "'LinkSheet(" & i & ")'" 
        If ActiveSheet.Name = Sh.Name Then SubMenuItem.FaceId = 1087 
    Next Sh 
     
End Sub 
 
Sub LinkSheet(ShtName As Integer) 
    If IsMissing(ShtName) Then Exit Sub 
     
    On Error Resume Next 
    Sheets(ShtName).Select 
    Range("A1").Select 
    On Error GoTo 0 
End Sub 
 
Sub DeleteMenu() 
     '   This sub should be executed when the workbook is closed
     '   Deletes the Menus
     
    On Error Resume Next 
     'Change &My Menu to the menu name you want
    Application.CommandBars(1).Controls("&My Menu").Delete 
    On Error GoTo 0 
End Sub