необходимо доработать макрос

[FormAlDeGid]

Бодрый день!
Есть макрос который собирает данные из разных книг в одну. и все в нем прекрасно но очень уж хотелось бы чтобы он перед каждым добавленным куском таблицы вставлял пустую строку (разделитель). подкоректируйте пжалста =)

Option Explicit

Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iPivotRange As Range, iDestinationRange As Range, iBeginRange As Range, Sheet
    Dim iRngAddress As String, oAwb As String, DataSheet As String, _
        iCopyAddress As String, sSheetName As String, oFile
    Dim lLastrow As Long, lLastRowMyBook As Long
    Dim iLastColumn As Integer
    Dim Str() As String

    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    DataSheet = ThisWorkbook.ActiveSheet.Name
    On Error Resume Next
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    If iBeginRange Is Nothing Then Exit Sub
    sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = "*.*"
        .Title = "Выберите файлы"
        If .Show = False Then Exit Sub
        For Each oFile In .SelectedItems
            Workbooks.OpenText Filename:=oFile
            oAwb = Dir(oFile, vbDirectory)

            Application.ScreenUpdating = False
            Workbooks(oAwb).Activate
            For Each Sheet In Sheets
                If Sheet.Name Like sSheetName Then
                    Sheet.Activate
                    Select Case iBeginRange.Count
                    Case 1
                        lLastrow = Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = Cells.SpecialCells(xlLastCell).Column
                        iCopyAddress = Range(Cells(iBeginRange.Row, iBeginRange.Column), Cells(lLastrow, iLastColumn)).Address
                    Case Else
                        iCopyAddress = iBeginRange.Address
                        lLastrow = iBeginRange.Rows.Count
                        iLastColumn = iBeginRange.Columns.Count
                    End Select
                    lLastRowMyBook = ThisWorkbook.Sheets(DataSheet).Cells.SpecialCells(xlLastCell).Row + 1
                    iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
                    Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(DataSheet).Range(iRngAddress)
                End If
            Next Sheet
            Workbooks(oAwb).Close False
        Next oFile
    End With
    Application.ScreenUpdating = True
End Sub

[SAS888]

А зачем Вы для вставки скопированного диапазона указываете диапазон? Достаточно указать 1-ю ячейку этого диапазона.
Замените строку Вашего кода

Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(DataSheet).Range(iRngAddress)

на строку

Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(DataSheet).Cells(lLastRowMyBook + 1, 1)

при этом формировать iRngAddress станет ни к чему.

P.S. В код макроса не вникал.

[FormAlDeGid]

SAS888 это не мое творение, а я кажися лашара... никак ладу не дам этому чуду.

как я понимаю эта строка

ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)

запускает всё в книге с макросом, но макрос у меня в PERSONAL.XLSB. поэтому ThisWorkbook целесобразно заменить на ActiveWorkbook и в строке ниже та же басня. и почти в самом низу кода опят выдает ошибку. отсюда пара вопросов:
-правильно ли я меняю команду?
-как исправить ошибку внизу?

Option Explicit

Sub Consolidated_Range_of_Books_and_Sheets()
    Dim iPivotRange As Range, iDestinationRange As Range, iBeginRange As Range, Sheet
    Dim iRngAddress As String, oAwb As String, DataSheet As String, _
        iCopyAddress As String, sSheetName As String, oFile
    Dim lLastrow As Long, lLastRowMyBook As Long
    Dim iLastColumn As Integer
    Dim Str() As String

    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    DataSheet = ThisWorkbook.ActiveSheet.Name
    On Error Resume Next
    Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _
                                           "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _
                                           vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8)
    If iBeginRange Is Nothing Then Exit Sub
    sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр")
    If sSheetName = "" Then sSheetName = "*"
    On Error GoTo 0
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = "*.*"
        .Title = "Выберите файлы"
        If .Show = False Then Exit Sub
        For Each oFile In .SelectedItems
            Workbooks.OpenText Filename:=oFile
            oAwb = Dir(oFile, vbDirectory)

            Application.ScreenUpdating = False
            Workbooks(oAwb).Activate
            For Each Sheet In Sheets
                If Sheet.Name Like sSheetName Then
                    Sheet.Activate
                    Select Case iBeginRange.Count
                    Case 1
                        lLastrow = Cells(1, 1).SpecialCells(xlLastCell).Row
                        iLastColumn = Cells.SpecialCells(xlLastCell).Column
                        iCopyAddress = Range(Cells(iBeginRange.Row, iBeginRange.Column), Cells(lLastrow, iLastColumn)).Address
                    Case Else
                        iCopyAddress = iBeginRange.Address
                        lLastrow = iBeginRange.Rows.Count
                        iLastColumn = iBeginRange.Columns.Count
                    End Select
                    lLastRowMyBook = ThisWorkbook.Sheets(DataSheet).Cells.SpecialCells(xlLastCell).Row + 1
                    iRngAddress = Range(Cells(lLastRowMyBook, 1), Cells(lLastRowMyBook + lLastrow, iLastColumn)).Address
                    Sheet.Range(iCopyAddress).Copy Destination:=ThisWorkbook.Sheets(DataSheet).Range(iRngAddress)
                End If
            Next Sheet
            Workbooks(oAwb).Close False
        Next oFile
    End With
    Application.ScreenUpdating = True
End Sub

[SAS888]

Вы же говорили, что

Есть макрос который собирает данные из разных книг в одну. и все в нем прекрасно

1. В Вашем случае, ThisWorkbook, естественно, по всему коду нужно заменить. Чтобы не отслеживать в коде, какая в данный момент книга активна, предлагаю создать объект Dim wb As Workbook и в коде присвоить ему Set wb = Workbooks("Имя_книги"). В дальнейшем, в коде использовать обращение к этому объекту.
2. Что за "ошибка внизу"?

[FormAlDeGid]

все прекрасно работало до момента переноса макроса из файла в мою книгу макросов.
ошибка в строке:

lLastRowMyBook = lol.Sheets(DataSheet).Cells.SpecialCells(xlLastCell).Row + 1

[SAS888]

Теперь другой вопрос: что в вашей строке

lLastRowMyBook = lol.Sheets(DataSheet).Cells.Special Cells(xlLastCell).Row + 1

означает "lol"?

Как я уже предлагал, если макрос запускается в тот момент, когда активна книга, в которую требуется добавлять лист DataSheet и работать с ней далее, то добавьте в Ваш код самой первой строкой

Dim wb As Workbook: Set wb = ActiveWorkbook

и далее по коду обращайтесь не ThisWorkbook.Sheets..., а wb.Sheets...

[FormAlDeGid]

=) "lol" это я для себя пометку ставил и не посмотрел что не с того места копирую, для форума.
строка с ошибкой выглядела так:

 lLastRowMyBook = ThisWorkbook.Sheets(DataSheet).Cells.SpecialCells(xlLastCell).Row + 1

но сейчас все шикарно. проверяю на корректность выполнения моих задач.

Примного вам благодарен. уже не впервой выручаете =)