VBA об'єднує кілька файлів Excel в одну книгу

Цей підручник покаже вам, як об’єднати кілька файлів Excel в одну книгу у VBA

Створення єдиної книги з кількох книг за допомогою VBA вимагає виконання кількох кроків.

  • Вам потрібно вибрати книги, з яких ви хочете вихідні дані - вихідні файли.
  • Вам потрібно вибрати або створити книгу, до якої ви хочете розмістити дані - файл призначення.
  • Вам потрібно вибрати аркуші з вихідних файлів, які вам потрібні.
  • Вам потрібно вказати код, де розмістити дані у файлі призначення.

Поєднання всіх аркушів з усіх відкритих книг у нову книгу як окремі аркуші

У наведеному нижче коді файли, з яких потрібно скопіювати інформацію, мають бути відкритими, оскільки Excel буде циклічно переглядати відкриті файли та копіювати інформацію у нову книгу. Код розміщено в книзі особистих макросів.

Ці файли - це ЄДИНІ файли Excel, які слід відкрити.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647 Додаткове поєднанняУвімкнено Помилка GoTo eh'оголошуйте змінні для зберігання необхідних об'єктівDim wbDestination As WorkbookDim wbSource As WorkbookЗатемнити wsSource як аркушDim wb Як робочий зошитDim sh як аркушDim strSheetName As StringDim strDestName As String'вимкніть оновлення екрана, щоб прискорити роботуApplication.ScreenUpdating = Неправда'спочатку створіть нову книгу призначенняВстановити wbDestination = Робочі книги. Додати'отримати назву нової книги, щоб виключити її з циклу нижчеstrDestName = wbDestination.Name'тепер перегляньте кожну з відкритих книг, щоб отримати дані, але виключіть вашу нову книгу або особисту книгу макросівДля кожного веб -сайту в програмі. Робочі книгиЯкщо wb.Name strDestName та wb.Name "PERSONAL.XLSB" ТодіВстановіть wbSource = wbДля кожного sh У wbSource.Worksheetssh.Copy After: = Робочі книги (strDestName). Таблиці (1)Далі шЗакінчити ЯкщоНаступна вб'тепер закрийте всі відкриті файли, крім нового файлу та книги особистого макросу.Для кожного веб -сайту в програмі. Робочі книгиЯкщо wb.Name strDestName та wb.Name "PERSONAL.XLSB" Тодіwb.Закрити НеправдаЗакінчити ЯкщоНаступна вб'видалити перший аркуш із цільової книгиApplication.DisplayAlerts = НеправдаАркуші ("Аркуш1"). ВидалитиApplication.DisplayAlerts = Правда'очистіть об'єкти, щоб звільнити пам'ятьВстановити wbDestination = НічогоВстановити wbSource = НічогоВстановити wsSource = НічогоВстановити wb = Нічого'увімкніть оновлення екрана, коли завершитеApplication.ScreenUpdating = НеправдаВийти з підпех:Опис помилки MsgBoxEnd Sub

Натисніть на діалогове вікно Макрос, щоб запустити процедуру на екрані Excel.

Тепер буде відображено ваш об’єднаний файл.

Цей код перебирав кожен файл і копіював аркуш у новий файл. Якщо будь -який з ваших файлів містить більше одного аркуша - він також скопіює їх - включаючи аркуші, на яких немає нічого!

Поєднання всіх аркушів з усіх відкритих робочих книг до одного робочого аркуша в новій робочій книзі

Нижче наведена процедура об’єднує інформацію з усіх аркушів у всіх відкритих книгах у єдиний аркуш у створеній новій книзі.

Інформація з кожного аркуша вставляється в аркуш призначення в останньому зайнятому рядку на аркуші.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 Додаткове об'єднанняУвімкнено Помилка GoTo eh'оголошуйте змінні для зберігання необхідних об'єктівDim wbDestination As WorkbookDim wbSource As WorkbookЗатемнити wsDestination як робочий аркушDim wb Як робочий зошитDim sh як аркушDim strSheetName As StringDim strDestName As StringЗатемнити iRws як ціле числоЗатемнити iCols як ціле числоDim totRws як ціле числоDim strEndRng як рядокПриглушити джерело як діапазон'вимкніть оновлення екрана, щоб прискорити роботуApplication.ScreenUpdating = Неправда'спочатку створіть нову книгу призначенняВстановити wbDestination = Робочі книги. Додати'отримати назву нової книги, щоб виключити її з циклу нижчеstrDestName = wbDestination.Name'тепер пройдіть по кожній із відкритих книг, щоб отримати даніДля кожного веб -сайту в програмі. Робочі книгиЯкщо wb.Name strDestName та wb.Name "PERSONAL.XLSB" ТодіВстановіть wbSource = wbДля кожного sh У wbSource.Worksheets'отримати кількість рядків і стовпців на аркушіш. АктивуватиActiveSheet.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). ВиберітьtotRws = ActiveCell.Row'перевірте, чи достатньо рядків для вставки данихЯкщо totRws + rngSource.Rows.Count> wsDestination.Rows.Count ТодіMsgBox "Недостатньо рядків для розміщення даних на аркуші консолідації."Перейти ехЗакінчити Якщо'додати рядок, щоб вставити в наступний рядок внизЯкщо totRws 1 Тоді totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Далі шЗакінчити ЯкщоНаступна вб'тепер закрийте всі відкриті файли, крім потрібногоДля кожного веб -сайту в програмі. Робочі книгиЯкщо wb.Name strDestName та wb.Name "PERSONAL.XLSB" Тодіwb.Закрити НеправдаЗакінчити ЯкщоНаступна вб'очистіть об'єкти, щоб звільнити пам'ятьВстановити wbDestination = НічогоВстановити wbSource = НічогоВстановити wsDestination = НічогоВстановити rngSource = НічогоВстановити wb = Нічого'увімкніть оновлення екрана, коли завершитеApplication.ScreenUpdating = НеправдаВийти з підпех:Опис помилки MsgBoxEnd Sub

Поєднання всіх аркушів із усіх відкритих робочих книг до одного робочого аркуша в активній робочій книзі

Якщо ви хочете перенести інформацію з усіх інших відкритих книг до тієї, у якій ви зараз працюєте, ви можете скористатися цим кодом нижче.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081 Додаткове об'єднанняУвімкнено Помилка GoTo eh'оголошуйте змінні для зберігання необхідних об'єктівDim wbDestination As WorkbookDim wbSource As WorkbookЗатемнити wsDestination як робочий аркушDim wb Як робочий зошитDim sh як аркушDim strSheetName As StringDim strDestName As StringЗатемнити iRws як ціле числоЗатемнити iCols як ціле числоDim totRws як ціле числоDim rngEnd As StringПриглушити джерело як діапазон'встановити активний об'єкт робочої книги для цільової книгиВстановити wbDestination = ActiveWorkbook'отримати ім'я активного файлуstrDestName = wbDestination.Name'вимкніть оновлення екрана, щоб прискорити роботуApplication.ScreenUpdating = Неправда'спочатку створіть новий робочий аркуш призначення у вашій активній книзіApplication.DisplayAlerts = Неправда'відновити наступну помилку, якщо аркуша немаєУвімкнути Помилка Відновити ДаліActiveWorkbook.Sheets ("Консолідація"). Видалити'скинути пастку помилок, щоб перейти до пастки помилок в кінціУвімкнено Помилка GoTo ehApplication.DisplayAlerts = Правда'додати новий аркуш до робочої книгиЗ ActiveWorkbookВстановити wsDestination = .Sheets.Add (Після: =. Sheets (.Sheets.Count))wsDestination.Name = "Консолідація"Закінчити з'тепер пройдіть по кожній із відкритих книг, щоб отримати даніДля кожного веб -сайту в програмі. Робочі книгиЯкщо wb.Name strDestName та wb.Name "PERSONAL.XLSB" ТодіВстановіть wbSource = wbДля кожного sh У wbSource.Worksheets'отримати кількість рядків на аркушіш. АктивуватиActiveSheet.Cells.SpecialCells (xlCellTypeLastCell).iRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells (iRws, iCols). АдресаВстановіть rngSource = sh.Range ("A1:" & rngEnd)'Знайдіть останній рядок на аркуші призначенняwbDestination.ActivateВстановити wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). ВиберітьtotRws = ActiveCell.Row'перевірте, чи достатньо рядків для вставки данихЯкщо totRws + rngSource.Rows.Count> wsDestination.Rows.Count ТодіMsgBox "Недостатньо рядків для розміщення даних на аркуші консолідації."Перейти ехЗакінчити Якщо'додайте рядок, щоб вставити в наступний рядок вниз, якщо ви не в першому рядкуЯкщо totRws 1 Тоді totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Далі шЗакінчити ЯкщоНаступна вб'тепер закрийте всі відкриті файли, крім потрібногоДля кожного веб -сайту в програмі. Робочі книгиЯкщо wb.Name strDestName та wb.Name "PERSONAL.XLSB" Тодіwb.Закрити НеправдаЗакінчити ЯкщоНаступна вб'очистіть об'єкти, щоб звільнити пам'ятьВстановити wbDestination = НічогоВстановити wbSource = НічогоВстановити wsDestination = НічогоВстановити rngSource = НічогоВстановити wb = Нічого'увімкніть оновлення екрана, коли завершитеApplication.ScreenUpdating = НеправдаВийти з підпех:Опис помилки MsgBoxEnd Sub

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

wave wave wave wave wave