Sub РАБОТЫ()
    Dim iBeginRange As Range, rCopy As Range, lCalc As Long, lCol As Long
    Dim oAwb As String, sCopyAddress As String, sSheetName As String
    Dim lLastRow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Worksheet, wsDataSheet As Worksheet, bPolyBooks As Boolean, avFiles
    Dim wbAct As Workbook
    Dim bPasteValues As Boolean, IsPasteSheetName As Boolean
    
    On Error Resume Next
    'Выбираем диапазон выборки с книг
    Set iBeginRange = Range("$A:$L") 'диапазон указывается нужный
    'Указываем имя листа
    sSheetName = "*"
    'вставлять только значения ячеек (без формул и форматов)
    bPasteValues = vbYes
    'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги)
    If MsgBox("Собрать работы с нескольких книг?", vbInformation + vbYesNo) = vbYes Then
        avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)
        If VarType(avFiles) = vbBoolean Then Exit Sub
        bPolyBooks = True
        lCol = 0
    Else
        avFiles = Array(ThisWorkbook.FullName)
    End If
    If IsPasteSheetName Then
        lCol = lCol + 1
    End If
    'отключаем обновление экрана, автопересчет формул и отслеживание событий
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlManual
    End With
    'создаем новый лист в книге для сбора
    Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    wsDataSheet.Name = "Сводная работ"
    'цикл по книгам
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then
            Set wbAct = Workbooks.Open(Filename:=avFiles(li))
        Else
            Set wbAct = ThisWorkbook
        End If
        oAwb = wbAct.Name
        'цикл по листам
        For Each wsSh In wbAct.Sheets
            If wsSh.Name Like sSheetName Then
                If wsSh.Visible = -1 Then
                    'Если имя листа совпадает с именем листа, в который собираем данные
                    'и сбор идет только с активной книги - то переходим к следующему листу
                    If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                    With wsSh
                        Select Case iBeginRange.Count
                        Case 1 'собираем данные начиная с указанной ячейки и до конца данных
                            lLastRow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                            iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                            sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastRow, iLastColumn)).Address
                        Case Else 'собираем данные с фиксированного диапазона
                            sCopyAddress = iBeginRange.Address
                        End Select
                        lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
                        'определяем для копирования диапазон только заполненных данных на листе
                        Set rCopy = Intersect(.Range(sCopyAddress).Parent.UsedRange, .Range(sCopyAddress))
                        'если вставляем только значения
                        rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
                        'End If
                    End With
                End If
            End If
NEXT_:
        Next wsSh
        Application.CutCopyMode = False
        If bPolyBooks Then
            wbAct.Close False
        End If
    Next li
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = lCalc
    End With
    Application.CutCopyMode = True
  End Sub