Sub CollectAllClients()
Dim BazaWb As Workbook 'текущая книга (общий файл)
Dim BazaSht As Worksheet 'лист База покупателей в общем файле
Dim iTempFileName As String 'имя по-очерёдно открываемого файла
Dim iPath As String 'путь к папке, где лежат все файлы
Dim iLastRowBaza As Long 'последняя заполненная строка в общем файле в столбце A
Dim iLastRowTempWb As Long 'последняя заполненная строка в по-очерёдно открываемом файле в столбце A
Dim iNumFiles As Long 'количество открываемых файлов
Dim LastRow As Long, LastColumn As Integer, i As Long, j As Integer
    Sheets("Общий").UsedRange.Rows.Hidden = False
    Sheets("Общий").UsedRange.Columns.Hidden = False
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Общий")
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xls")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     'Рабочая книга не должна быть защищена паролем
                     With .Worksheets("Лист1")
                          'номер последней заполенной строки
                          iLastRowTempWb = .Cells(Rows.Count, 1).End(xlUp).Row
                          iLastRowBaza = BazaSht.Cells(Rows.Count, 2).End(xlUp).Row + 1
                          .Range(.Cells(2, 1), .Cells(iLastRowTempWb, 36)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 2)
                     End With
                     .Close SaveChanges:=False
                     Name iPath & iTempFileName As iPath & "Архив\" & iTempFileName
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   MsgBox "Информация собрана из " & iNumFiles & " файлов!", vbInformation, "Конец"
    Range("I:I,K:K,R:R,S:S,T:T,AF:AF,AG:AG,AH:AH,AI:AI,AJ:AJ,AK:AK").Select
    Selection.EntireColumn.Hidden = True
    End Sub

If Target.Cells.Count > 1 Then Exit SubIf Intersect(Target, Range("V:V") Is Nothing Then
Target.Interior.Color = 13434879
Else
Target.Interior.Color = 5296274

Me.TextBox1.Text = Application.VLookup(ListBox1, Sheets("Коды").Range("A:B"), 2, 0)
ActiveCell.Value = TextBox1.Text