Sub All_File4()
    Dim sh As Worksheet, wsDataSheet As Object, lLastCol As Long
    Dim sFolder As String, sFiles As String, FileMask As String
    Dim iCell1 As Range, iCell2 As Range, iCell3 As Range, iCell11 As Range, iCell13 As Range, iCell15 As Range, iCell17 As Range
    Dim iCell19 As Range
'--------------------------------Откл.Обновление связей и экрана----------------------------------------
With Application
lCalc = .Calculation
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual: .DisplayAlerts = False: .AskToUpdateLinks = False
.PrintCommunication = False: '.ActivePrinter = "*Brother*DCP-L5500DN*series*" '.Dialogs (xlDialogPrinterSetup)
End With
'-------------------------------------------------------------------------------------------------------
Set wsDataSheet = ActiveWorkbook.Sheets("Обратная связь не экспресс") 'Лист на который вставляются значения
lLastCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
'-------------------------------------------------------------------------------------------------------
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
'-----------------------------------Открываем книгу-----------------------------------------------------
FileMask = "*.xls*"
    sFiles = Dir(sFolder & FileMask)
Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open Filename:=sFolder & sFiles
'        On Error Resume Next
'---------------------------------------Цикл по листам--------------------------------------------------
For Each sh In Worksheets
'-------------------------------------------------------------------------------------------------------
'Лист на котором производиться поиск
If InStr(sh.Name, "Обратная связь") Then
MsgBox "ok"
'-------------------------------------------------------------------------------------------------------
Set iCell1 = sh.Range("B4").Value
Set iCell2 = sh.Range("B5").Value
Set iCell3 = sh.Range("B6").Value
Set iCell11 = sh.Range("D10:E10").Value
'iCell12 = sh.Range("E10").Value
Set iCell13 = sh.Range("D11:E11").Value
'iCell14 = sh.Range("E11").Value
Set iCell15 = sh.Range("D12:E12").Value
'iCell16 = sh.Range("E12").Value
Set iCell17 = sh.Range("D13:E13").Value
'iCell18 = sh.Range("E13").Value
Set iCell19 = sh.Range("D14:E14").Value
'iCell110 = sh.Range("E14").Value (Cells(1, 1), Cells(10, 1))
'MsgBox "ok"
'-------------------------------------------Вставка данных на лист вывода--------------------------------
'     wsDataSheet.Range(Cells(1, lLastCol), Cells(1, lLastCol + 1)).Value = iCell1
'     wsDataSheet.Range(Cells(2, lLastCol), Cells(2, lLastCol + 1)).Value = ActiveWorkbook.Path
'     wsDataSheet.Range.Cells(4, lLastCol).Value = iCell2
'     wsDataSheet.Range.Cells(3, lLastCol).Value = iCell3
MsgBox "ok"
     wsDataSheet.Range(Cells(6, lLastCol), Cells(6, lLastCol + 1)).Value = iCell11
''     wsDataSheet.Cells(6, lLastCol).Value = iCell12
'     wsDataSheet.Range.Cells(7, lLastCol).Value = iCell13
''     wsDataSheet.Cells(7, lLastCol).Value = iCell14
'     wsDataSheet.Range.Cells(8, lLastCol).Value = iCell15
''     wsDataSheet.Cells(8, lLastCol).Value = iCell16
'     wsDataSheet.Range.Cells(9, lLastCol).Value = iCell17
''     wsDataSheet.Cells(9, lLastCol).Value = iCell18
'     wsDataSheet.Range.Cells(10, lLastCol).Value = iCell19
''     wsDataSheet.Cells(10, lLastCol).Value = iCell110
     lLastCol = lLastCol + 1
'-------------------------------------------------------------------------------------------------------
End If
Next sh
'----------------------------------------Закрываем книгу------------------------------------------------
        ActiveWorkbook.Close False 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
Loop
'--------------------------------Вкл.Обновление связей и экрана-----------------------------------------
With Application
lCalc = .Calculation
.ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc: .DisplayAlerts = True: .AskToUpdateLinks = True
.PrintCommunication = True: '.ActivePrinter = "*Brother*DCP-L5500DN*series*" '.Dialogs (xlDialogPrinterSetup)
End With
End Sub