VBA Połącz wiele plików Excela w jeden skoroszyt

Ten samouczek pokaże Ci, jak połączyć wiele plików Excela w jeden skoroszyt w VBA

Tworzenie pojedynczego skoroszytu z wielu skoroszytów przy użyciu VBA wymaga wykonania szeregu kroków.

• Musisz wybrać skoroszyty, z których chcesz uzyskać dane źródłowe - pliki źródłowe.
• Musisz wybrać lub utworzyć skoroszyt, do którego chcesz umieścić dane - plik docelowy.
• Musisz wybrać arkusze z żądanych plików źródłowych.
• Musisz wskazać kodowi, gdzie umieścić dane w pliku docelowym.

Łączenie wszystkich arkuszy ze wszystkich otwartych skoroszytów w nowy skoroszyt jako pojedyncze arkusze

W poniższym kodzie pliki, z których chcesz skopiować informacje, muszą być otwarte, ponieważ program Excel przejdzie przez otwarte pliki i skopiuje informacje do nowego skoroszytu. Kod jest umieszczany w skoroszycie makr osobistych.

Te pliki są JEDYNYMI plikami Excela, które powinny być otwarte.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineMultipleFiles()W przypadku błędu Przejdź do eh'deklaruj zmienne do przechowywania wymaganych obiektów'Dim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource As WorksheetDim wb jako skoroszytDim sh jako arkusz roboczyDim strSheetName jako ciągDim strDestName jako ciąg'wyłącz aktualizację ekranu, aby przyspieszyć działanieApplication.ScreenUpdating = Fałsz'najpierw utwórz nowy skoroszyt docelowyUstaw wbDestination = Skoroszyty.Dodaj'pobierz nazwę nowego skoroszytu, aby wykluczyć go z poniższej pętlistrDestName = wbDestination.Name'teraz przejdź przez każdy otwarty skoroszyt, aby pobrać dane, ale wyklucz nową książkę lub skoroszyt makr osobistychDla każdego wb In Application.WorkbooksJeśli wb.Name strDestName And wb.Name "PERSONAL.XLSB" WtedyUstaw wbSource = wbDla każdego sh In wbSource.Worksheetssh.Copy After:=Skoroszyty(strDestName).Arkusze(1)Następny shZakończ, jeśliNastępny wb'teraz zamknij wszystkie otwarte pliki z wyjątkiem nowego pliku i skoroszytu makr osobistych.Dla każdego wb In Application.WorkbooksJeśli wb.Name strDestName And wb.Name "PERSONAL.XLSB" Wtedywb.Zamknij FałszZakończ, jeśliNastępny wb'usuń arkusz pierwszy ze skoroszytu docelowegoApplication.DisplayAlerts = FalseArkusze("Arkusz1").UsuńApplication.DisplayAlerts = Prawda„Oczyść obiekty, aby zwolnić pamięć”Ustaw wbDestination = NicUstaw wbSource = NicUstaw wsSource = NicUstaw wb = Nic'włącz aktualizację ekranu po zakończeniuApplication.ScreenUpdating = FałszWyjście Subech:MsgBox Err.OpisNapis końcowy

Kliknij okno dialogowe Makro, aby uruchomić procedurę z ekranu programu Excel.

Twój połączony plik zostanie teraz wyświetlony.

Ten kod przeszedł przez każdy plik i skopiował arkusz do nowego pliku. Jeśli którykolwiek z twoich plików ma więcej niż jeden arkusz - skopiuje je również - w tym arkusze, na których nic nie ma!

Łączenie wszystkich arkuszy ze wszystkich otwartych skoroszytów w jeden arkusz roboczy w nowym skoroszycie

Poniższa procedura łączy informacje ze wszystkich arkuszy we wszystkich otwartych skoroszytach w jeden arkusz w nowo tworzonym skoroszycie.

Informacje z każdego arkusza są wklejane do arkusza docelowego w ostatnim zajętym wierszu arkusza roboczego.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Łącz podrzędneWieleArkuszy()W przypadku błędu Przejdź do eh'deklaruj zmienne do przechowywania wymaganych obiektów'Dim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorksheetDim wb jako skoroszytDim sh jako arkusz roboczyDim strSheetName jako ciągDim strDestName jako ciągDim iRws jako liczba całkowitaDim iCols jako liczba całkowitaDim totRws As IntegerDim strEndRng As StringDim rngSource As Range'wyłącz aktualizację ekranu, aby przyspieszyć działanieApplication.ScreenUpdating = Fałsz'najpierw utwórz nowy skoroszyt docelowyUstaw wbDestination = Skoroszyty.Dodaj'pobierz nazwę nowego skoroszytu, aby wykluczyć go z poniższej pętlistrDestName = wbDestination.Name'teraz przejdź przez każdy z otwartych skoroszytów, aby uzyskać daneDla każdego wb In Application.WorkbooksJeśli wb.Name strDestName And wb.Name "PERSONAL.XLSB" WtedyUstaw wbSource = wbDla każdego sh In wbSource.Worksheets'pobierz liczbę wierszy i kolumn w arkuszush.AktywujActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).AktywujiRws = AktywnaKomórka.WiersziCols = AktywnaKomórka.Kolumna'ustaw zakres ostatniej komórki w arkuszustrEndRng = sh.Cells(iRws, iCols).Adres'ustaw zakres źródłowy do skopiowaniaUstaw rngSource = sh.Range("A1:" i strEndRng)'znajdź ostatni wiersz w arkuszu docelowym'wbDestination.ActivateUstaw wsDestination = Aktywny arkuszwsDestination.Cells.SpecialCells(xlCellTypeLastCell).WybierztotRws = AktywnaKomórka.Wiersz'sprawdź, czy jest wystarczająco dużo wierszy, aby wkleić daneJeśli totRws + rngSource.Rows.Count > wsDestination.Rows.Count toMsgBox "Za mało wierszy, aby umieścić dane w arkuszu Konsolidacja."Idź do ehZakończ, jeśli'dodaj wiersz do wklejenia w następnym wierszu w dółJeśli totRws 1 Wtedy totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" i totRws)Następny shZakończ, jeśliNastępny wb'teraz zamknij wszystkie otwarte pliki oprócz tego, który chceszDla każdego wb In Application.WorkbooksJeśli wb.Name strDestName And wb.Name "PERSONAL.XLSB" Wtedywb.Zamknij FałszZakończ, jeśliNastępny wb„Oczyść obiekty, aby zwolnić pamięć”Ustaw wbDestination = NicUstaw wbSource = NicUstaw wsDestination = NicUstaw rngSource = NicUstaw wb = Nic'włącz aktualizację ekranu po zakończeniuApplication.ScreenUpdating = FałszWyjście Subech:MsgBox Err.OpisNapis końcowy

Łączenie wszystkich arkuszy ze wszystkich otwartych skoroszytów w jeden arkusz w aktywnym skoroszycie

Jeśli chcesz przenieść informacje ze wszystkich innych otwartych skoroszytów do tego, w którym aktualnie pracujesz, możesz użyć tego kodu poniżej.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Podrzędne łączenie wielu arkuszy z istniejącym ()W przypadku błędu Przejdź do eh'deklaruj zmienne do przechowywania wymaganych obiektów'Dim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorksheetDim wb jako skoroszytDim sh jako arkusz roboczyDim strSheetName jako ciągDim strDestName jako ciągDim iRws jako liczba całkowitaDim iCols jako liczba całkowitaDim totRws As IntegerDim rngEnd As StringDim rngSource As Range'ustaw aktywny obiekt skoroszytu dla książki docelowejUstaw wbDestination = ActiveWorkbook'pobierz nazwę aktywnego plikustrDestName = wbDestination.Name'wyłącz aktualizację ekranu, aby przyspieszyć działanieApplication.ScreenUpdating = Fałsz'najpierw utwórz nowy arkusz docelowy w swoim aktywnym skoroszycieApplication.DisplayAlerts = False'wznów kolejny błąd w przypadku, gdy arkusz nie istniejePrzy błędzie Wznów DalejActiveWorkbook.Sheets("Konsolidacja").Usuń'zresetuj pułapkę błędu, aby przejść do pułapki błędu na końcuW przypadku błędu Przejdź do ehApplication.DisplayAlerts = Prawda'dodaj nowy arkusz do skoroszytuZ ActiveWorkbookUstaw wsDestination = .Sheets.Add(Po:=.Sheets(.Sheets.Count))wsDestination.Name = "Konsolidacja"Kończyć z'teraz przejdź przez każdy z otwartych skoroszytów, aby uzyskać daneDla każdego wb In Application.WorkbooksJeśli wb.Name strDestName And wb.Name "PERSONAL.XLSB" WtedyUstaw wbSource = wbDla każdego sh In wbSource.Worksheets'pobierz liczbę wierszy w arkuszush.AktywujActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).AktywujiRws = AktywnaKomórka.WiersziCols = AktywnaKomórka.KolumnarngEnd = sh.Cells(iRws, iCols).AdresUstaw rngSource = sh.Range("A1:" & rngEnd)'znajdź ostatni wiersz w arkuszu docelowym'wbDestination.ActivateUstaw wsDestination = Aktywny arkuszwsDestination.Cells.SpecialCells(xlCellTypeLastCell).WybierztotRws = AktywnaKomórka.Wiersz'sprawdź, czy jest wystarczająco dużo wierszy, aby wkleić daneJeśli totRws + rngSource.Rows.Count > wsDestination.Rows.Count toMsgBox "Za mało wierszy, aby umieścić dane w arkuszu Konsolidacja."Idź do ehZakończ, jeśli'dodaj wiersz do wklejenia w następnym wierszu w dół, jeśli nie znajdujesz się w wierszu 1Jeśli totRws 1 Wtedy totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" i totRws)Następny shZakończ, jeśliNastępny wb'teraz zamknij wszystkie otwarte pliki oprócz tego, który chceszDla każdego wb In Application.WorkbooksJeśli wb.Name strDestName And wb.Name "PERSONAL.XLSB" Wtedywb.Zamknij FałszZakończ, jeśliNastępny wb„Oczyść obiekty, aby zwolnić pamięć”Ustaw wbDestination = NicUstaw wbSource = NicUstaw wsDestination = NicUstaw rngSource = NicUstaw wb = Nic'włącz aktualizację ekranu po zakończeniuApplication.ScreenUpdating = FałszWyjście Subech:MsgBox Err.OpisNapis końcowy