Содержание
Из этого туториала Вы узнаете, как объединить несколько файлов Excel в одну книгу в VBA.
Создание одной книги из нескольких книг с использованием VBA требует выполнения ряда шагов.
- Вам нужно выбрать книги, из которых вы хотите получить исходные данные - Исходные файлы.
- Вам необходимо выбрать или создать книгу, в которую вы хотите поместить данные - целевой файл.
- Вам необходимо выбрать листы из исходных файлов, которые вам нужны.
- Вам нужно указать коду, куда поместить данные в целевом файле.
Объединение всех листов из всех открытых книг в новую книгу в виде отдельных листов
В приведенном ниже коде файлы, из которых вам нужно скопировать информацию, должны быть открыты, поскольку Excel будет перебирать открытые файлы и копировать информацию в новую книгу. Код помещается в личную книгу макросов.
Эти файлы - ЕДИНСТВЕННЫЕ файлы Excel, которые должны быть открыты.
| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647 | Sub CombineMultipleFiles ()При ошибке GoTo а'объявляем переменные для хранения требуемых объектовDim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource As WorksheetDim wb As WorkbookРабочий лист Dim sh AsDim strSheetName как строкаDim strDestName As String'отключите обновление экрана, чтобы ускорить работуApplication.ScreenUpdating = False'сначала создайте новую целевую книгуУстановите wbDestination = Workbooks.Add.'получить имя новой книги, чтобы исключить ее из цикла нижеstrDestName = wbDestination.Name'теперь пройдитесь по каждой из открытых книг, чтобы получить данные, но исключите вашу новую книгу или личную книгу макросовДля каждого ББ в Application.WorkbooksЕсли wb.Name strDestName и wb.Name "PERSONAL.XLSB" ТогдаУстановите wbSource = wbДля каждого sh в wbSource.Worksheetssh.Copy After: = Рабочие книги (strDestName) .Sheets (1)Следующий шКонец, еслиСледующий wb'теперь закройте все открытые файлы, кроме нового файла и личной книги макросов.Для каждого ББ в Application.WorkbooksЕсли wb.Name strDestName и wb.Name "PERSONAL.XLSB" Тогдаwb.Close FalseКонец, еслиСледующий wb'удалить первый лист из целевой книгиApplication.DisplayAlerts = FalseТаблицы ("Лист1"). УдалитьApplication.DisplayAlerts = True'очистить объекты, чтобы освободить памятьУстановите wbDestination = NothingУстановите wbSource = NothingУстановите wsSource = NothingУстановите wb = Nothing'включить обновление экрана по завершенииApplication.ScreenUpdating = FalseВыйти из подводной лодкиа:MsgBox Ошибка ОписаниеКонец подписки |
Щелкните диалоговое окно «Макрос», чтобы запустить процедуру с экрана Excel.
Теперь ваш объединенный файл будет отображаться.
Этот код прошел через каждый файл и скопировал лист в новый файл. Если в каком-либо из ваших файлов больше одного листа - он скопирует и их - включая листы, на которых ничего нет!
Объединение всех листов из всех открытых книг в один лист в новой книге
Приведенная ниже процедура объединяет информацию со всех листов во всех открытых книгах в один рабочий лист в новой создаваемой книге.
Информация из каждого листа вставляется в целевой лист в последней занятой строке рабочего листа.
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 | Sub CombineMultipleSheets ()При ошибке GoTo а'объявляем переменные для хранения требуемых объектовDim wbDestination As WorkbookDim wbSource As WorkbookDim ws Назначение как рабочий листDim wb As WorkbookРабочий лист Dim sh AsDim strSheetName как строкаDim strDestName As StringDim iRws как целое числоDim iCols как целое числоDim totRws как целое числоDim strEndRng как строкаDim rngSource As Range'отключите обновление экрана, чтобы ускорить работуApplication.ScreenUpdating = False'сначала создайте новую целевую книгуУстановите wbDestination = Workbooks.Add.'получить имя новой книги, чтобы исключить ее из цикла нижеstrDestName = wbDestination.Name'теперь переберите каждую открытую книгу, чтобы получить данныеДля каждого ББ в Application.WorkbooksЕсли wb.Name strDestName и wb.Name "PERSONAL.XLSB" ТогдаУстановите wbSource = wbДля каждого sh в wbSource.Worksheets'получить количество строк и столбцов на листеsh.ActivateActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). АктивироватьiRws = ActiveCell.RowiCols = ActiveCell.Column'установить диапазон последней ячейки в листеstrEndRng = sh.Cells (iRws, iCols). Адрес'установить исходный диапазон для копированияУстановите rngSource = sh.Range ("A1:" & strEndRng)'найти последнюю строку в листе назначенияwbDestination.ActivateУстановить wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell) .SelecttotRws = ActiveCell.Row'проверьте, достаточно ли строк для вставки данныхЕсли totRws + rngSource.Rows.Count> wsDestination.Rows.Count ТогдаMsgBox «Недостаточно строк для размещения данных на листе консолидации».GoTo аКонец, если'добавить строку для вставки в следующую строку внизЕсли totRws 1 Тогда totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Следующий шКонец, еслиСледующий wb'теперь закройте все открытые файлы, кроме нужногоДля каждого ББ в Application.WorkbooksЕсли wb.Name strDestName и wb.Name "PERSONAL.XLSB" Тогдаwb.Close FalseКонец, еслиСледующий wb'очистить объекты, чтобы освободить памятьУстановите wbDestination = NothingУстановите wbSource = NothingУстановите wsDestination = NothingУстановите rngSource = NothingУстановите wb = Nothing'включить обновление экрана по завершенииApplication.ScreenUpdating = FalseВыйти из подводной лодкиа:MsgBox Ошибка ОписаниеКонец подписки |
Объединение всех листов из всех открытых книг в один рабочий лист в активной книге
Если вы хотите перенести информацию из всех других открытых книг в ту, с которой вы в настоящее время работаете, вы можете использовать этот код ниже.
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081 | Sub CombineMultipleSheetsToExisting ()При ошибке GoTo а'объявляем переменные для хранения требуемых объектовDim wbDestination As WorkbookDim wbSource As WorkbookDim ws Назначение как рабочий листDim wb As WorkbookРабочий лист Dim sh AsDim strSheetName как строкаDim strDestName As StringDim iRws как целое числоDim iCols как целое числоDim totRws как целое числоDim rngEnd As StringDim rngSource As Range'установить активный объект книги для целевой книгиУстановите wbDestination = ActiveWorkbook'получить имя активного файлаstrDestName = wbDestination.Name'отключите обновление экрана, чтобы ускорить работуApplication.ScreenUpdating = False'сначала создайте новый рабочий лист назначения в вашей активной книгеApplication.DisplayAlerts = False'возобновить следующую ошибку, если лист не существуетПри ошибке Возобновить ДалееActiveWorkbook.Sheets («Консолидация»). Удалить'сбросить ловушку ошибок, чтобы перейти к ловушке ошибок в концеПри ошибке GoTo аApplication.DisplayAlerts = True'добавить новый лист в книгуС ActiveWorkbookУстановите wsDestination = .Sheets.Add (After: =. Sheets (.Sheets.Count))wsDestination.Name = "Консолидация"Конец с'теперь переберите каждую открытую книгу, чтобы получить данныеДля каждого ББ в Application.WorkbooksЕсли wb.Name strDestName и wb.Name "PERSONAL.XLSB" ТогдаУстановите wbSource = wbДля каждого sh в wbSource.Worksheets'получить количество строк в листеsh.ActivateActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). АктивироватьiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells (iRws, iCols) .AddressУстановите rngSource = sh.Range ("A1:" & rngEnd)'найти последнюю строку в листе назначенияwbDestination.ActivateУстановите wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell) .SelecttotRws = ActiveCell.Row'проверьте, достаточно ли строк для вставки данныхЕсли totRws + rngSource.Rows.Count> wsDestination.Rows.Count ТогдаMsgBox «Недостаточно строк для размещения данных на листе консолидации».GoTo аКонец, если'добавить строку для вставки в следующей строке вниз, если вы не в строке 1Если totRws 1 Тогда totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Следующий шКонец, еслиСледующий wb'теперь закройте все открытые файлы, кроме нужногоДля каждого ББ в Application.WorkbooksЕсли wb.Name strDestName и wb.Name "PERSONAL.XLSB" Тогдаwb.Close FalseКонец, еслиСледующий wb'очистить объекты, чтобы освободить памятьУстановите wbDestination = NothingУстановите wbSource = NothingУстановите wsDestination = NothingУстановите rngSource = NothingУстановите wb = Nothing'включить обновление экрана по завершенииApplication.ScreenUpdating = FalseВыйти из подводной лодкиа:MsgBox Ошибка ОписаниеКонец подписки |
