Sub Test()   
Dim arr(3) As String
arr(1) = "Test"
arr(2) = "Test 2"
arr(3) = "Test 3"
MsgBox Join(arr, vbCrLf)
End Sub

Sub Test()
    
Dim arr(3) As String

arr(1) = "Test"
arr(2) = "Test 2"
arr(3) = "Test 3"
a = ""
For i = UBound(arr) To LBound(arr)
    a = a & arr(i)
Next i
MsgBox a

End Sub

For Ndx = LBound(arr) To ((UBound(arr) - LBound(arr) + 1) \ 2)
    Temp = arr(Ndx)
arr(Ndx) = arr(Ndx2)
arr(Ndx2) = Temp
    Ndx2 = Ndx2 - 1
Next Ndx

Userform1 .Show

uf="Userform1 "
uf.Show

With OBJHTTP
        .Open "POST", Url, False
        .setRequestHeader "Accept", "*/*"
        .setRequestHeader "Content-type", "application/json"
        .setRequestHeader "Origin", "https://p2p.binance.com"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.198 Safari/537.36"
        .send "{""page"":1,""rows"":1,""payTypes"":[],""asset"":""USDT"",""tradeType"":""BUY"",""fiat"":""RUB"",""transAmount"":1000,""publisherType"":null,""merchantCheck"":false}"
        bin_answer_buy = .ResponseText
End With

Dim TimeToRun

Sub MyMacro()
Dim abook As Workbook
Set abook = ThisWorkbook
lr = abook.Sheets("Report").Cells(Rows.Count, 1).End(xlUp).Row
abook.Sheets("Report").Cells(lr + 1, 1) = Format(Now, "hh:mm:ss")
Call NextRun 
End sub

Sub NextRun()

    TimeToRun = Now + TimeValue("00:00:02")
    Application.OnTime TimeToRun, "MyMacro"

End Sub

[I2].FormulaR1C1 = "=VLOOKUP(R[-1]C[4],'" & CFile & "]Лист1'!C1:C9,9,0)"

Application.Run "C:\Users\IMantrov\Desktop\......" 'полностью не получается прописать путь к макросу

With Лист1
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        lc = .Cells(5, .Columns.Count).End(xlToLeft).Column
        For r = 6 To lr
            i = 0
            For c = 8 To lc
                If 'здесь должно содержаться условие, что ячейка определенного цвета
                    i = i + 1
                End If
            Next
            .Cells(r, lc + 1) = i 'В конце каждой строки ставится количество ячеек с обусловленным цветом
        Next
    End With

ActiveSheet.ListObjects("Графики").Range.AutoFilter Field:=14, Criteria1:= _
        RGB(0, 0, 0), Operator:=xlFilterCellColor
    With ActiveSheet.ListObjects("Графики").AutoFilter.Filters(14).Criteria1
        .Pattern = xlPatternRectangularGradient
        .Gradient.RectangleLeft = 0.5
        .Gradient.RectangleRight = 0.5
        .Gradient.RectangleTop = 0.5
        .Gradient.RectangleBottom = 0.5
        .Gradient.ColorStops.Clear
    End With
    With ActiveSheet.ListObjects("Графики").AutoFilter.Filters(14).Criteria1. _
        Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With ActiveSheet.ListObjects("Графики").AutoFilter.Filters(14).Criteria1. _
        Gradient.ColorStops.Add(1)
        .Color = 7434613
        .TintAndShade = 0
    End With

[A3:H3].AutoFilter Field:=4, Criteria1:=Array("Первый критерий", "Второй критерий", "Третий критерий", "Четвертый критерий"), Operator:=xlFilterValues

Dim WsAr, i&    
WsAr = Array("СФ", "ЮФ", "МФ")
    For i = LBound(WsAr) To UBound(WsAr)
        With Worksheets(WsAr(i))
            iPath = ActiveWorkbook.Path
            newbookname = .Name
           'Сюда нужно вставить операцию по созданию новой книги с присвоением ей имени переменной newbookname
           'и сохранять ее в iPath (папка с исходной книгой)
        End With
    Next

Dim abook As Workbook
    Set abook = ActiveWorkbook
    Dim daway As String, item As String
    Dim somebook As Excel.Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выбери папку с файлами, которые надо перебрать"
        If .Show = 0 Then
            Exit Sub
        End If
        daway = .SelectedItems(1)
    End With
    item = Dir(PathName:=daway + "\*.xls*")
    Do Until item = ""
        Set somebook = Workbooks.Open(daway + "\" + item)
        'Действия с книгой
        somebook.Close
        item = Dir
    Loop
    Set somebook = Nothing

    Dim objNetwork As Object
    Set objNetwork = CreateObject("WScript.Network")
    ComputerName = objNetwork.ComputerName
    Set objNetwork = Nothing
    If ComputerName Like "IMANTROV-NB" Then
        'Операции для меня    
    else        
        'Операции для других пользователей
    End If

For cl = 1 To .UsedRange.Columns.Count
      If .Cells(1, cl).Value Like "Скидка*" Then .Cells(1, cl).EntireColumn.Delete
      If .Cells(1, cl).Value Like "*999*" Then .Cells(1, cl).EntireColumn.Delete
Next

Dim abook As Workbook
    Set abook = ActiveWorkbook
    Dim fileway As String, Objct As String
    Dim xlfile As Excel.Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "OK"
        .Title = "Выбери папку"
        If .Show = 0 Then
            Exit Sub
        End If
        fileway = .SelectedItems(1)
    End With
    Objct = Dir(PathName:=fileway + "\*.xlsx")
    Do Until Objct = ""
        Set xlfile = Workbooks(fileway + "\" + Objct)
        nm = xlfile.Name
        If nm Like "*20*.xlsx*" Then
            lrg = abook.Sheets("Svod").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("List1").Select
            [A1].Copy abook.Sheets("Svod").Cells(lrg + 1, 1)
        End If
        xlfile.Close
        Objct = Dir
    Loop
    Set xlfile = Nothing

Set xlfile = Workbooks(fileway + "\" + Objct)

Set xlfile = Workbooks.Open(fileway + "\" + Objct)

.[A:Q].AutoFilter Field:=4, Criteria1:=Array("A", "B", "C"), Operator:=xlFilterValues

.[A:Q].AutoFilter Field:=1, Criteria1:="abc*"

.[A:Q].AutoFilter Field:=4, Criteria1:=Array("A*", "B*", "C*"), Operator:=xlFilterValues

With Sheets("Расхождения")
    datapi = Sheets("Макрос").Range("B3") - 1
    datai = Sheets("Макрос").Range("F5")
    For u = 1 To .UsedRange.Columns.Count
        If .Cells(1, u).Value Like "Дата учета" Then
            .Range("A:X").AutoFilter Field:=u, Criteria1:= _
            "<=" & CDbl(CDate(datapi)), Operator:=xlAnd, Criteria2:=">=" & CDbl(CDate(datai))
        End If
    Next
    End With

With List4
        lrv = Application.CountA(.Columns(1).SpecialCells(12))
        If lrv > 2 Then
            .Range(.Cells(2, 1), .Cells(lrv, 3)).SpecialCells(12).Copy List3.[A1]
        End If
End With

With Лист2
    threecol = Лист1.[I6]
    .[A:S].AutoFilter Field:=3, Criteria1:="Товар оприходован"
    .[A:S].AutoFilter Field:=11, Criteria1:=">" & threecol
End With

ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields("Корзина").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields("Дата корзины"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)

ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields("Корзина").Subtotals(1) = False
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields("Дата корзины").Subtotals(1) = False

.[C1] = "Сумма"

.Range("C1") = "Сумма"

.Range("E2:E" & lr) 'тут переменная обозначает нижний край выделения

.Range("J2", .Range("K2").End(xlDown))

lr = .Cells(.Rows.Count, 1).End(xlUp).Row

With Лист1
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
lrdk = Sheets("ДопКорзины").Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To .UsedRange.Columns.Count
        If .Cells(1, j).Value Like "Номер" Then
            If lrdk > 0 Then
            .Range(.Cells(1, j), .Cells(lr, j)).Copy Sheets("ДопКорзины").Cells(lrdk + 1, 1)
            Else
            .Range(.Cells(1, j), .Cells(lr, j)).Copy Sheets("ДопКорзины").Range("A1")
            End If
        End If
    Next
End With