.....
        With targetWorkbook.Application.CommandBars("cell").Controls.Add(1, , , 1)
            .Parent.Controls(2).BeginGroup = True
            .Caption = "Копировать адрес диапазона"
            .FaceId = 550
            .OnAction = "test123"
        End With
......

        Dim NewExcel As Object
        Set NewExcel = CreateObject("Excel.Application")
        NewExcel.Workbooks.Open "C:\123.xlsx"
        NewExcel.Goto NewExcel.Sheets(ThisWorkbook.Sheets(1).Cells(1, "A").Value).Cells(ThisWorkbook.Sheets(1).Cells(3, "O").Value, 1)
        NewExcel.Visible = True
        NewExcel.WindowState = xlMaximized

Dim NewExcel As Object        
Set NewExcel = CreateObject("Excel.Application")
NewExcel.Workbooks.Open "C:\123.xlsx"
NewExcel.Visible = True

Application.Goto Workbooks.Open("C:\123.xlsx").Sheets(ThisWorkbook.Sheets(1).Cells(1, "A").Value).Cells(ThisWorkbook.Sheets(1).Cells(3, "O").Value, 1)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(Application.Transpose(Sheet1.Range("Таблица1[Тест]").Value), ",")
    End With
End Sub

    Dim qt As QueryTable    
    Set qt = ActiveWorkbook.Sheets("TEMP").QueryTables.Add(Connection:="URL;" & url, Destination:=Range("A1"))

  Sub QueryGoogleSheets()
      Dim qt As QueryTable, url As String, key As String, gid As String
 
      If ActiveSheet.QueryTables.Count > 0 Then ActiveSheet.QueryTables(1).Delete
      ActiveSheet.Cells.Clear
 
      key = "1WopmB1ExWSNul9sw9n7I9FEyquS4AyEugt_fKQrHJSI"
      url = "https://spreadsheets.google.com/tq?tqx=out:html&key=" & key
 
      gid = "2009384141"
      url = url & "&gid=" & gid
 
      Set qt = ActiveSheet.QueryTables.Add(Connection:="URL;" & url, _
      Destination:=Range("$A$1"))
 
      With qt
          .WebSelectionType = xlAllTables
          .WebFormatting = xlWebFormattingNone
          .Refresh
      End With
  End Sub

   With Application.CommandBars("List Range Popup").Controls.Add(1, , , 1)
    .Parent.Controls(2).BeginGroup = True
    .OnAction = "Test"
    .Caption = "Тест2"
   End With

Sub CreateItemsInCellContextMenu()
   With Application.CommandBars("cell").Controls.Add(1, , , 1)
    .Parent.Controls(2).BeginGroup = True
    .OnAction = "Test"
    .Caption = "Тест2"
   End With
   
   With Application.CommandBars("List Range Popup").Controls.Add(1, , , 1)
    .Parent.Controls(2).BeginGroup = True
    .OnAction = "Test"
    .Caption = "Тест2"
   End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Application.CommandBars("cell").Reset
    
End Sub

Private Sub Workbook_Deactivate()

    Application.CommandBars("cell").Reset
    
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    CreateItemsInCellContextMenu
    
End Sub

Sub CreateItemsInCellContextMenu()

   On Error Resume Next

   Application.CommandBars("cell").Reset
   Application.CommandBars("cell").Controls(1).BeginGroup = True

   With Application.CommandBars("cell").Controls.Add(1, , , 1)
      .OnAction = "Test"
      .Caption = "Тест2"
   End With
   
End Sub

Sub Test()

    MsgBox "Работает"

End Sub