VBA Комбинирайте множество файлове на Excel в една работна книга

Този урок ще ви покаже как да комбинирате няколко Excel файла в една работна книга във VBA

Създаването на една работна книга от редица работни книги с помощта на VBA изисква редица стъпки, които трябва да се следват.

• Трябва да изберете работните книги, от които искате изходните данни - Изходните файлове.
• Трябва да изберете или създадете работната книга, в която искате да поставите данните - дестинационния файл.
• Трябва да изберете листовете от изходните файлове, които ви трябват.
• Трябва да кажете на кода къде да поставите данните в целевия файл.

Комбиниране на всички листове от всички отворени работни книги в нова работна книга като отделни листове

В кода по -долу файловете, от които трябва да копирате информацията, трябва да бъдат отворени, тъй като Excel ще прегледа отворените файлове и ще копира информацията в нова работна книга. Кодът се поставя в личната работна книга за макроси.

Тези файлове са единствените файлове на Excel, които трябва да бъдат отворени.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Подкомбинирайте множество файлове ()При грешка GoTo, а'декларират променливи, за да държат необходимите обектиDim wbDestination As WorkbookDim wbSource As WorkbookЗатъмнете wsSource като работен листDim wb Като работна книгаDim sh като работен листDim strSheetName As StringDim strDestName As String'изключете актуализирането на екрана, за да ускорите нещатаApplication.ScreenUpdating = False„първо създайте нова работна книга за местоназначениеЗадайте wbDestination = Workbooks.Add'вземете името на новата работна книга, така че да я изключите от цикъла по -долуstrDestName = wbDestination.Name„сега прегледайте всяка от работните книги, отворени, за да получите данните, но изключете новата си книга или личната работна книга за макросиЗа всяка wb в Application.WorkbooksАко wb.Name strDestName и wb.Name "PERSONAL.XLSB" ТогаваЗадайте wbSource = wbЗа всеки sh В wbSource.Worksheetssh.Copy After: = Работни книги (strDestName). Листове (1)Следващ шКрай АкоСледваща wb'сега затворете всички отворени файлове, с изключение на новия файл и личната работна книга за макроси.За всяка wb в Application.WorkbooksАко wb.Name strDestName и wb.Name "PERSONAL.XLSB" Тогаваwb.Close FalseКрай АкоСледваща wb„премахване на първи лист от работната книга на местоназначениетоApplication.DisplayAlerts = FalseЛистове („Лист1“). ИзтриванеApplication.DisplayAlerts = Вярно„почистете обектите, за да освободите паметтаЗадайте wbDestination = НищоЗадайте wbSource = НищоЗадайте wsSource = НищоЗадайте wb = Нищо'включете актуализирането на екрана, когато приключитеApplication.ScreenUpdating = FalseИзход от Subа:MsgBox Err. ОписаниеEnd Sub

Щракнете върху диалоговия прозорец Макрос, за да изпълните процедурата от екрана на Excel.

Вашият комбиниран файл сега ще се покаже.

Този код претърсва всеки файл и копира листа в нов файл. Ако някой от вашите файлове има повече от един лист - той ще копира и тези - включително листовете без нищо!

Комбиниране на всички листове от всички отворени работни книги в един работен лист в нова работна книга

Процедурата по -долу комбинира информацията от всички листове във всички отворени работни книги в един работен лист в нова работна книга, която е създадена.

Информацията от всеки лист се поставя в целевия лист в последния зает ред на работния лист.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()При грешка GoTo, а'декларират променливи, за да държат необходимите обектиDim wbDestination As WorkbookDim wbSource As WorkbookЗатъмнете wsDestination като работен листDim wb Като работна книгаDim sh като работен листDim strSheetName As StringDim strDestName As StringЗатъмнете iRws като цяло числоЗатъмнете iCols като цяло числоDim totRws As IntegerDim strEndRng As StringDim rngSource As Range'изключете актуализирането на екрана, за да ускорите нещатаApplication.ScreenUpdating = False„първо създайте нова работна книга за местоназначениеЗадайте wbDestination = Workbooks.Add'вземете името на новата работна книга, така че да я изключите от цикъла по -долуstrDestName = wbDestination.Name'сега прегледайте всяка от работните книги, отворени, за да получите даннитеЗа всяка wb в Application.WorkbooksАко 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'сега затворете всички отворени файлове с изключение на този, който искатеЗа всяка wb в Application.WorkbooksАко wb.Name strDestName и wb.Name "PERSONAL.XLSB" Тогаваwb.Close FalseКрай АкоСледваща wb„почистете обектите, за да освободите паметтаЗадайте wbDestination = НищоЗадайте wbSource = НищоЗадайте wsDestination = НищоЗадайте rngSource = НищоЗадайте wb = Нищо'включете актуализирането на екрана, когато приключитеApplication.ScreenUpdating = FalseИзход от Subа:MsgBox Err. ОписаниеEnd Sub

Комбиниране на всички листове от всички отворени работни книги в един работен лист в активна работна книга

Ако искате да пренесете информацията от всички други отворени работни книги в тази, в която работите в момента, можете да използвате този код по -долу.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()При грешка GoTo, а'декларират променливи, за да държат необходимите обектиDim wbDestination As WorkbookDim wbSource As WorkbookЗатъмнете wsDestination като работен листDim wb Като работна книгаDim sh като работен листDim strSheetName As StringDim strDestName As StringЗатъмнете iRws като цяло числоЗатъмнете iCols като цяло числоDim totRws As IntegerDim rngEnd As StringDim rngSource As Range'задайте активния обект на работна книга за целевата книгаЗадайте wbDestination = ActiveWorkbook'получи името на активния файлstrDestName = wbDestination.Name'изключете актуализирането на екрана, за да ускорите нещатаApplication.ScreenUpdating = False„първо създайте нов работен лист за местоназначение във вашата активна работна книгаApplication.DisplayAlerts = False„възобновяване на следващата грешка в случай, че листът не съществуваНа грешка възобновяване следващоActiveWorkbook.Sheets ("Consolidation"). Изтриване„нулиране на капана за грешки, за да преминете към капана за грешки в краяПри грешка GoTo, аApplication.DisplayAlerts = Вярно„добавете нов лист към работната книгаС ActiveWorkbookЗадайте wsDestination = .Sheets.Add (След: =. Sheets (.Sheets.Count))wsDestination.Name = "Консолидация"Край с'сега прегледайте всяка от работните книги, отворени, за да получите даннитеЗа всяка wb в Application.WorkbooksАко 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 "Няма достатъчно редове за поставяне на данните в работния лист за консолидация."ОтидиКрай Ако'добавете ред, който да поставите на следващия ред надолу, ако не сте в ред 1Ако totRws 1 Тогава totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Следващ шКрай АкоСледваща wb'сега затворете всички отворени файлове с изключение на този, който искатеЗа всяка wb в Application.WorkbooksАко wb.Name strDestName и wb.Name "PERSONAL.XLSB" Тогаваwb.Close FalseКрай АкоСледваща wb„почистете обектите, за да освободите паметтаЗадайте wbDestination = НищоЗадайте wbSource = НищоЗадайте wsDestination = НищоЗадайте rngSource = НищоЗадайте wb = Нищо'включете актуализирането на екрана, когато приключитеApplication.ScreenUpdating = FalseИзход от Subа:MsgBox Err. ОписаниеEnd Sub