For i = 1 To UBound(arr_Mass)
        If arr_Mass(i, 13) = "Открыт" Then
            ListBox1.AddItem arr_Mass(i, 1)
            ListBox1.List(Me.ListBox1.ListCount - 1, 1) = arr_Mass(i, 2)
            ListBox1.List(Me.ListBox1.ListCount - 1, 2) = arr_Mass(i, 6)
            ListBox1.List(Me.ListBox1.ListCount - 1, 3) = arr_Mass(i, 8)
            ListBox1.List(Me.ListBox1.ListCount - 1, 4) = arr_Mass(i, 9)
        End If
    Next

    For i = 1 To UBound(arr_Garage)
        'If InStr(1, arr_Garage(i, 2), Id_Client, vbTextCompare) = 1 Then А ЭТОТ ВАРИАНТ НЕ ПРАВИЛЬНЫЙ
        If arr_Garage(i, 2).Value = Id_Client.Value Then ЭТО ВАРИАНТ НЕ ПРОКАНЫВАЕТ
            Me.ListBox2.AddItem arr_Garage(i, 1)
            Me.ListBox2.List(Me.ListBox2.ListCount - 1, 1) = arr_Garage(i, 3)
            Me.ListBox2.List(Me.ListBox2.ListCount - 1, 2) = arr_Garage(i, 4)
            Me.ListBox2.List(Me.ListBox2.ListCount - 1, 3) = arr_Garage(i, 5)
            Me.ListBox2.List(Me.ListBox2.ListCount - 1, 4) = arr_Garage(i, 6)
            Me.ListBox2.List(Me.ListBox2.ListCount - 1, 5) = arr_Garage(i, 7) & " RUS"
            Me.ListBox2.List(Me.ListBox2.ListCount - 1, 6) = arr_Garage(i, 8) & " ã."
        End If
    Next

      ID_Marka = Me.ListBox3.List(Me.ListBox3.ListIndex, 0)
    Marka = Me.ListBox3.List(Me.ListBox3.ListIndex, 1)
    'MsgBox ID_Marka ' тут к примеру 10
   
        For i = 1 To UBound(arrSrc2)
        If arrSrc2(i, 3) = ID_Marka Then ' arrSrc2(10, 3) = 10 то же 10

            Me.ListBox4.AddItem arrSrc2(i, 1)
            Me.ListBox4.List(Me.ListBox4.ListCount - 1, 1) = arrSrc2(i, 4)
        End If
    Next

    For i = 1 To UBound(arr_Client)
            Me.ListBox1.AddItem arr_Client(i, 1)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = arr_Client(i, 2)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = arr_Client(i, 6)
    Next

=СУММЕСЛИМН(Табл[Сумма];МЕСЯЦ(Табл[Дата]);2)

Sub CreatFiles()
    Dim strFilename, strDirname, strPathname, strDefpath As String
    On Error Resume Next ' If directory exist goto next line
    strDirname = "ТЕСТ2" ' New directory name

    strFilename = Intersect(Range("ДДС[Реквизиты]"), ActiveCell.EntireRow).Value 'New file name
    strDefpath = Application.ActiveWorkbook.Path 'Default path name
    If IsEmpty(strDirname) Then Exit Sub
    If IsEmpty(strFilename) Then Exit Sub

    MkDir strDefpath & "\" & strDirname
    strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
    MsgBox strPathname
    
    
    Workbooks.Add.SaveAs Filename:=strPathname & ".xls", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    
    
End Sub

Intersect(Range("Таблица[Ссылка]"), ActiveCell.EntireRow).Value = ВОТ ТУТ ЧТО ТО ДОЛЖНО БЫТЬ, при этом на конце ссылки брать данные из ячейки 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Me.Cells.Font.Bold = False
    ActRow = ActiveCell.Row
    Rows(ActRow).Font.Bold = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range, CrossRange As Range
    Set WorkRange = Range("A7:N300")    'адрес рабочего диапазона с таблицей
    If Target.Count > 1 Then Exit Sub
    If Coord_Selection = False Then
        WorkRange.FormatConditions.Delete
        Exit Sub
    End If
    Application.ScreenUpdating = False
    If Not Intersect(Target, WorkRange) Is Nothing Then
        Set CrossRange = Intersect(WorkRange, Union(Target.EntireRow, Target.EntireColumn))
        WorkRange.FormatConditions.Delete
        CrossRange.FormatConditions.Add Type:=xlExpression, Formula1:="=1"
        CrossRange.FormatConditions(1).Interior.ColorIndex = 33
        Target.FormatConditions.Delete
    End If
End Sub

If Target.Column = 13 Then

End if

If Target.Column = Target("Таблица[столбец1]") Then

End if

If Not (Worksheets("Лист2").Range("Таблица2[id_poselka]").Find(What:=id_poselka, LookIn:=xlFormulas, LookAt:=xlWhole)) Is Nothing Then
                        st1 = Worksheets("Ëèñò2").Range("Таблица2[id_poselka]").Find(What:=id_poselka, LookIn:=xlFormulas, LookAt:=xlWhole).Offset(0, 2).value