.....
        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.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)

    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

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

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
   <ribbon startFromScratch="false">
      <tabs>   
          <tab id="tab" label="Подборщик кодов ТНВЭД">
             <group id="Группа_1" label="Наименования">
            <dropDown id="MyDropDown" 
                          sizeString="AAAAAAAAAAAAAAAAAAAAA" 
                          onAction="DropDown_OnAction"> 
              <item id="One" label="Наименование 1"/> 
              <item id="Two" label="Наименование 2"/> 
              <item id="Three" label="Наименование 3"/> 
              <button id="button" label="Прочее" onAction="Button_OnAction" /> 
            </dropDown> 
            </group>   
      </tab>
      </tabs>
   </ribbon>
</customUI>

<div class="col-25">
  <div class="boxSubstrate boxSubstrate-offset-0">
    <div class="padding-default-2">
      <h2><b class="halfbold">Код ТН ВЭД</b><br>
        <span class="h1 jTnvedCodeFormat">8501510001</span>
      </h2>
      <a class="codeTip-off f-right btn btn-blue btn-icon btn-icon-small" title="Открыть дерево ТН ВЭД" href="/tnved/?tnved=8501510001">
        <i class="fa fa-book"></i>
      </a>
      <p><i>Асинхронные двигатели переменного тока многофазные, номинальной выходной мощностью не более 750 вт</i></p>
                        
    </div>
  </div>
</div>

 With ListView1

        .ListItems.Clear
        .ColumnHeaders.Clear
        
        .FullRowSelect = True
        .Gridlines = True
        
        For i = 1 To UBound(arrList, 2)

            .ColumnHeaders.Add , , arrList(1, i)

            For j = 2 To UBound(arrPackingList)

                If i = 1 Then
                
                    .ListItems.Add , , arrList(j, i)
                    
                Else
                
                    .ListItems(j - 1).SubItems(i - 1) = arrList(j, i)

                End If

            Next j

        Next i

    End With

Public Property Get SelectedCell() As Range
    Set SelectedCell = ActiveCell
End Property

Public cntTextBox&             ' Счетчик
Public TextBox_Top&            ' Счетчик
Public arrUserFormControls()   ' Массив
Public cntRowUserFormControls& ' Счетчик 

Private Sub CommandButton1_Click()
    
    Dim NTT As Control
    Set NTT = Me.Controls.Add("Forms.TextBox.1", "TextBox" & (50 + cntTextBox))
    
    ReDim Preserve arrUserFormControls(1 To 1, 1 To cntRowUserFormControls)
    arrUserFormControls(1, cntRowUserFormControls) = 50 + cntTextBox
    
    cntTextBox = cntTextBox + 1
    
    With NTT
    
        .Height = 18
        .Width = 115
        .Left = 12
        .Top = 264 + TextBox_Top

    End With

    TextBox_Top = TextBox_Top + 24
    cntRowUserFormControls = cntRowUserFormControls + 1

End Sub

Public WithEvents NTT As MSForms.TextBox

Private Sub NTT_Change()

    MsgBox "Работает"

End Sub

Private Sub TextBox2_AfterUpdate()

   If IsNumeric(TextBox2) Then UserForm.TextBox2.Value = Format(UserForm.TextBox2.Value, "#,##0,00")

End Sub

Private Sub TextBox2_Exit(ByVal cancel As MSForms.ReturnBoolean)

   TextBox2 = Format(TextBox2, "#,##0,00")

End Sub

Private Sub TextBox2_Change()

   TextBox2 = Format(TextBox2, "#,##0,00")

End Sub

Private Sub UserForm_Initialize()

    Dim ComboBoxCount As Integer
    Dim ComboBoxArray() As Object
    Dim i As Integer
    
    ComboBoxCount = 5
    
    ReDim ComboBoxArray(1 To ComboBoxCount)
    
    For i = 1 To ComboBoxCount
        Set ComboBoxArray(i) = Me.Controls.Add("Forms.ComboBox.1", "ComboBox" & i, True)
        With ComboBoxArray(i)
            .Left = 10
            .Top = (i - 1) * 30
            .Width = 100
            .Height = 20
        End With
    Next i

End Sub

Dim text As String
text = "0108808956276942215Aa:GOD0urSdD 0108808956276942215'Aai+?UGnB%6 0108808956276942215AfG%Ea%m9IDT 0108808956276942215aGstiVpQT4i* 0108808956276942215AkJLjR65)zlT 0108808956276942215ALVMlMFaYueS 0108808956276942215aMaE-RW""*hSB 010"
ThisWorkbook.Sheets(1).Cells(1, 1) = text

   With Sheet1.Range("Таблица1[Тестовый_столбец]") 

      .FormatConditions.Add Type:=xlTextString, String:="Значение1234", TextOperator:=xlContains
      .FormatConditions(.FormatConditions.Count).SetFirstPriority
      .FormatConditions(1).Interior.Color = 65535

   End With

 
Dim i As Long, j As Long
Dim temp As Variant

    'Сортируем по первому столбцу
    For i = LBound(arrUniqueValues, 1) To UBound(arrUniqueValues, 1) - 1
        For j = i + 1 To UBound(arrUniqueValues, 1)

            If arrUniqueValues(i, 1) > arrUniqueValues(j, 1) Then

                temp = arrUniqueValues(i, 1)
                arrUniqueValues(i, 1) = arrUniqueValues(j, 1)
                arrUniqueValues(j, 1) = temp

                temp = arrUniqueValues(i, 2)
                arrUniqueValues(i, 2) = arrUniqueValues(j, 2)
                arrUniqueValues(j, 2) = temp

                temp = arrUniqueValues(i, 3)
                arrUniqueValues(i, 3) = arrUniqueValues(j, 3)
                arrUniqueValues(j, 3) = temp
            End If

        Next j
    Next i

    'Сортируем по второму столбцу
    For i = LBound(arrUniqueValues, 1) To UBound(arrUniqueValues, 1) - 1
        For j = i + 1 To UBound(arrUniqueValues, 1)

            If arrUniqueValues(i, 1) = arrUniqueValues(j, 1) And _
               arrUniqueValues(i, 2) > arrUniqueValues(j, 2) Then
                
                temp = arrUniqueValues(i, 2)
                arrUniqueValues(i, 2) = arrUniqueValues(j, 2)
                arrUniqueValues(j, 2) = temp

                temp = arrUniqueValues(i, 3)
                arrUniqueValues(i, 3) = arrUniqueValues(j, 3)
                arrUniqueValues(j, 3) = temp
            End If

        Next j
    Next i

Sub test()

    Dim shp As Shape
    
    For Each shp In ws.Shapes
        shp.Delete
    Next shp

End Sub

Sub test()

Dim shape As Excel.shape

For Each shape In ActiveSheet.Shapes

    Select Case shape.Type
        Case msoPicture, msoMedia, msoShapeTypeMixed, msoOLEControlObject, msoAutoShape
            shape.Delete
        Case Else
            'Do nothing
    End Select

Next

End Sub