Sub MakeMenu() '
    Dim cmdBar As CommandBar, cmdBar1 As CommandBar, cmdBar2 As CommandBar
    For Each cmdBar In Application.CommandBars
        If cmdBar.Name = "Cell" Then
            If cmdBar1 Is Nothing Then
                Set cmdBar1 = cmdBar
                MakeMenu_2 cmdBar
            Else
                Set cmdBar2 = cmdBar
                MakeMenu_2 cmdBar: Exit For
            End If
        End If
    Next cmdBar
End Sub
 
Sub MakeMenu_2(ByVal cmdBar) 'Добавление пунктов контекстного меню
    Dim NewMenu As CommandBarControl, Item As CommandBarControl, ws As Worksheet, MenuCount As Long, i As Long, Arr_ws As String, SheetCount As Variant

        For Each ws In Worksheets
            If ws.Visible = True Then Arr_ws = Join(Array(ws.Name, Arr_ws), ",")
        Next ws
            SheetCount = Split(Arr_ws, ",")
            
        ReDim Cap(1 To UBound(SheetCount))
        ReDim Mac(1 To UBound(SheetCount))
            For i = 1 To UBound(SheetCount)
                Cap(i) = SheetCount(UBound(SheetCount) - i)
                Mac(i) = "Sw_Sh" & Sheets(SheetCount(UBound(SheetCount) - i)).Index
            Next i
    
'        Добавление меню
        MenuCount = cmdBar.Controls.Count
        Set NewMenu = cmdBar.Controls.Add(Type:=msoControlPopup, temporary:=True)
        NewMenu.Caption = "&Переход на лист"
     
        For i = 1 To UBound(SheetCount) 'Добавление пунктов меню
            Set Item = NewMenu.Controls.Add(Type:=msocontrolbutton, temporary:=True)
            Item.Caption = Cap(i)
            Item.OnAction = Mac(i)
       Next i
End Sub

Sub DeleteMenu() 'Удаление меню перед закрытием
    On Error Resume Next
    cmdBar1.Controls("&Переход на лист").Delete
    cmdBar2.Controls("&М").Delete
End Sub