Копирование данных с определённого массива с несколько листов в один

Option Explicit
 
Sub ConsolidatedRangeOfBrandsAndRegions()
    
    Dim iBeginRange As Object, lCalc As Long, lCol As Long
    Dim sCopyAddress As String, sSheetName As String
    Dim oAwb As String, lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
    Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
    Dim s, N As Integer
    Dim shtname As Variant
    On Error Resume Next
    
'   1. Выбираем диапазон выборки с книг
    Set iBeginRange = Range("$A$1:$Q$4")
'   2. Указываем листы для сбора
    N = 17
    For s = 1 To Application.Worksheets.Count
    Worksheets(N).Activate
    shtname = ActiveSheet.Name
'   3. Указываем имя листа. Допустимо указывать в имени листа символы подставки ? и *.
'   Если указать только * то данные будут собираться со всех листов
'    sSheetName = ("Винница" "Волынь" "Днепр" "Донецк" "Житомир" "Закарпатье" _
'        "Запорожье" "Ив-Франковск" "Киев" "Кировоград" "Крым" "Луганск" "Львов" _
'        "Николаев" "Одесса" "Полтава" "Ровно" "Сумы" "Тернополь" "Харьков" "Херсон" _
'        "Хмельницкий" "Черкассы" "Чернигов" "Черновцы")
'   5. Если имя листа не указано - данные будут собраны со вех листов
'    If sSheetName = "" Then sSheetName = "*"
'    On Error GoTo 0
    avFiles = Array(ThisWorkbook.FullName)
'   8. Указываем куда собирать данные. Либо создаём новый лист в книге для сбора после
'   текущего листа After:=ActiveSheet либо в конец After:=Sheets(Sheets.Count)
'    ThisWorkbook.Sheets.Add After:=ActiveSheet
'    Set wsDataSheet = ThisWorkbook.ActiveSheet
    Set wsDataSheet = ThisWorkbook.Worksheets(2)
'   9. цикл по книгам
    For li = LBound(avFiles) To UBound(avFiles)
        If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)
        oAwb = Dir(avFiles(li), vbDirectory)
        '10. цикл по листам
        For Each wsSh In Workbooks(oAwb).Sheets
            If wsSh.Name Like sSheetName Then
                '11. Если имя листа совпадает с именем листа, в который собираем данные
                'и сбор идет только с активной книги - то переходим к следующему листу
                If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_
                With wsSh
                    Select Case iBeginRange.Count
                    Case 1 '12. собираем данные начиная с указанной ячейки и до конца данных
                        lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row
                        If lLastrow > 4 Then lLastrow = 4
                        iLastColumn = .Cells.SpecialCells(xlLastCell).Column
                        sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address
                    Case Else
'   13. собираем данные с фиксированного диапазона
                        sCopyAddress = iBeginRange.Address
                    End Select
                    lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1
'   14. вставляем имя книги и листа, с которой собраны данные
'                    If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = oAwb + "\" + wsSh.Name
                    If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(Range(sCopyAddress).Rows.Count).Value = wsSh.Name
                    .Range(sCopyAddress).Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol)
                End With
            End If
NEXT_:
        Next wsSh
        If bPolyBooks Then Workbooks(oAwb).Close False
    N = N + 1
    Next li
    
'   15. переименовываем лист с данными
'   ThisWorkbook.Worksheets(2).Name = "fdata"
End Sub

Dim s As Integer, N As Integer