Создание итогового Файла

[Flangini]

Добрый день!
Помогите с макросом, пожалуйста!

Имеем три Книги (Книга1, Книга2, Книга3). Из Книга2 Лист1 копируем диапазон ячеек в Книга1 Лист1, затем из Книга3 Лист1 копируем тот же диапазон ячеек в Книга1 Лист1 начиная с первой пустой ячейки после предыдушего копирования. То есть диапазон может быть заполненым не полностью. Для более подробной илюстрации своих слов прилагаю файлы. (В файле Книга1 Лист1 уже показано что нужно получить).

[Евгений ГВС]

Если в списках в Книга2 и Книга3 нет пустых строк внутри списка, то можно использовать метод CurrentRegion для получения диапазона, ограниченного пустыми строками.

Option Explicit

Public Sub UpdateKniga1()

Dim nextRow As Integer

Workbooks("Книга1.xls").Worksheets( "Лист1").Cells.Clear

Workbooks("Книга2.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Copy
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(1, 1).PasteSpecial

nextRow = Workbooks("Книга2.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Rows.Count + 1

Workbooks("Книга3.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Copy
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(nextRow, 1).PasteSpecial
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(nextRow, 1).EntireRow.Delete

End Sub

[SAS888]

Надежнее так:

Sub UpdateKniga1()
    Dim sh1 As Worksheet, sh2 As Worksheet, i As Long: Application.ScreenUpdating = False
    Set sh1 = Workbooks("Книга2.xls").Sheets("Лист1"): Set sh2 = Workbooks("Книга3.xls").Sheets("Лист1")
    ThisWorkbook.Sheets(1).Activate: Cells.Clear: sh1.UsedRange.Copy [A1]
    i = ActiveSheet.UsedRange.Rows.Count + 1: sh2.UsedRange.Copy Cells(i, 1): Rows(i).Delete
End Sub

Копируются все данные. В последствии, если требуется, можно удалить пустые строки.

P.S. Макрос должен находиться в программном модуле книги "Книга1.xls".

[Flangini]

На самом деле у меня около 150 файлов, первый макрос от Евгений ГВС я смог дополнить получил:

Public Sub UpdateKniga1()

Dim nextRow As Integer

Workbooks("Книга1.xls").Worksheets( "Лист1").Cells.Clear

Workbooks("Книга2.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Copy
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(1, 1).PasteSpecial

nextRow = Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Rows.Count + 1

Workbooks("Книга3.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Copy
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(nextRow, 1).PasteSpecial
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(nextRow, 1).EntireRow.Delete

nextRow = Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Rows.Count + 1

Workbooks("Книга4.xls").Worksheets( "Лист1").Cells(1, 1).CurrentRegion.Copy
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(nextRow, 1).PasteSpecial
Workbooks("Книга1.xls").Worksheets( "Лист1").Cells(nextRow, 1).EntireRow.Delete

End Sub

а Ваш код, SAS888, к сожалению не знаю как модернизировать

[SAS888]

На самом деле у меня около 150 файлов...

Так Вы сформулируйте задачу полностью. Просто добавлять 150 строк кода, по-моему, глуповато.

[Flangini]

Сообщение от SAS888

.. добавлять 150 строк кода, по-моему, глуповато.

Абсолютно с Вами согласен!!! но за отсутствием необходимых знаний мне пока больше ничего не остаётся

Задача: Есть 150 файлов, в которых на Лист1 содержится информация о людях, необходимо скопировать данные из этих файлов в один, добавив столбец "Название файла", чтобы потом можно было определить из какого файла была скопирована та или иная инфа.