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 'êîëè÷åñòâî îòêðûâàåìûõ ôàéëîâ

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Лист3")
               
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xlsm")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     With .Worksheets("Лист3")
                        'ïîñëåäíÿÿ ñòðîêà â îòêðûòîì ôàéëå
                        If .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1).MergeCells Then
                            iLastRowTempWb = .Cells(Rows.Count, 5).End(xlUp).Row + 1
                        Else
                            iLastRowTempWb = .Cells(Rows.Count, 5).End(xlUp).Row
                        End If
                        'ïîñëåäíÿÿ ñòðîêà â áàçå
                        If BazaSht.Cells(Rows.Count, 1).End(xlUp).MergeCells Then
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 5).End(xlUp).Row + 2
                        Else
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 5).End(xlUp).Row + 1
                        End If
                        
                        'Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
                        
                          .Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                          
                          
                          
                          
                     End With
                     .Close saveChanges:=False
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Èíôîðìàöèÿ ñîáðàíà èç " & iNumFiles & " ôàéëîâ!", vbInformation, "Êîíåö"
End Sub

Sheets("Лист3").Protect "111", UserInterfaceOnly:=True