VBA kombinira više Excel datoteka u jednu radnu knjigu

Ovaj će vam vodič pokazati kako kombinirati više Excel datoteka u jednu radnu knjigu u VBA -i

Stvaranje jedne radne knjige iz više radnih knjiga pomoću VBA zahtijeva niz koraka koje je potrebno slijediti.

• Morate odabrati radne knjige iz kojih želite izvorne podatke - izvorne datoteke.
• Morate odabrati ili stvoriti radnu knjigu u koju želite staviti podatke - datoteku Odredište.
• Morate odabrati listove iz izvornih datoteka koje trebate.
• Morate reći kodu gdje smjestiti podatke u datoteku Odredište.

Kombiniranje svih listova iz svih otvorenih radnih knjiga u novu radnu knjigu kao pojedinačnih listova

U donjem kodu datoteke iz kojih morate kopirati podatke moraju biti otvorene jer će Excel proći kroz otvorene datoteke i kopirati podatke u novu radnu knjigu. Kôd se nalazi u Osobnoj radnoj knjizi makronaredbi.

Ove su datoteke JEDINE Excel datoteke koje bi trebale biti otvorene.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Podkombinirajte više datoteka ()Uključeno Greška GoTo eh'deklariraju varijable za držanje potrebnih objekataZatamni wbDestination As WorkbookZatamni wbSource kao radnu knjiguZatamni wsSource kao radni listDim wb Kao radna bilježnicaDim sh As Radni listDim strSheetName As StringDim strDestName As String'isključite ažuriranje zaslona kako biste ubrzali stvariApplication.ScreenUpdating = Netačno'prvo stvorite novu odredišnu radnu knjiguPostavi wbDestination = Radne knjige.Dodaj'dobiti naziv nove radne knjige pa ćete je isključiti iz donje petljestrDestName = wbDestination.Name'sada prođite kroz svaku od otvorenih radnih knjiga kako biste dobili podatke, ali isključite svoju novu knjigu ili osobnu radnu knjigu makronaredbiZa svaku web stranicu U primjeni.Radne knjigeAko wb.Name strDestName i wb.Name "PERSONAL.XLSB" TadaPostavite wbSource = wbZa svaki sh U wbSource.Radni listovish.Copy After: = Radne knjige (strDestName) .Listovi (1)Sljedeći shZavrši akoSljedeća wb'sada zatvorite sve otvorene datoteke osim nove datoteke i radne knjige Osobne makronaredbe.Za svaku web stranicu U primjeni.Radne knjigeAko wb.Name strDestName i wb.Name "PERSONAL.XLSB" Tadawb.Zatvori NetačnoZavrši akoSljedeća wb'uklonite prvi list iz odredišne ​​radne knjigeApplication.DisplayAlerts = NetačnoListovi ("List 1"). IzbrišiteApplication.DisplayAlerts = Istina'očistite predmete kako biste oslobodili memorijuPostavi wbDestination = NištaPostavi wbSource = NištaPostavi wsSource = NištaPostavite wb = Ništa'uključite ažuriranje zaslona kada dovršiteApplication.ScreenUpdating = NetačnoIzlaz iz podvEh:MsgBox Err.OpisKraj podm

Pritisnite dijaloški okvir Makro da biste pokrenuli postupak s ekrana programa Excel.

Sada će se prikazati vaša kombinirana datoteka.

Ovaj kôd je prošao kroz svaku datoteku i kopirao list u novu datoteku. Ako bilo koja od vaših datoteka ima više od jednog lista - kopirat će se i oni - uključujući listove na kojima nema ničega!

Kombiniranje svih listova iz svih otvorenih radnih knjiga u jedan radni list u novoj radnoj svesci

Postupak u nastavku kombinira podatke sa svih listova u svim otvorenim radnim bilježnicama u jedan radni list u novoj radnoj knjizi koja se stvara.

Podaci sa svakog lista zalijepljeni su na odredišni list u posljednjem zauzetom retku na radnom listu.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

PodkombinirajViše listova ()Uključeno Greška GoTo eh'deklariraju varijable za držanje potrebnih objekataDim wbDestination As WorkbookZatamni wbSource kao radnu knjiguZatamni wsDestination kao radni listDim wb Kao radna bilježnicaDim sh As Radni listDim strSheetName As StringDim strDestName As StringZatamnite iRws kao cijeli brojZatamnite iCols kao cijeli brojZatamni totRws kao cijeli brojZatamni strEndRng kao nizZatamnite izvor kao raspon'isključite ažuriranje zaslona kako biste ubrzali stvariApplication.ScreenUpdating = Netačno'prvo stvorite novu odredišnu radnu knjiguPostavi wbDestination = Radne knjige.Dodaj'dobiti naziv nove radne knjige pa ćete je isključiti iz donje petljestrDestName = wbDestination.Name'sada prođite kroz svaku od otvorenih radnih knjiga kako biste dobili podatkeZa svaku web stranicu U primjeni.Radne knjigeAko wb.Name strDestName i wb.Name "PERSONAL.XLSB" TadaPostavite wbSource = wbZa svaki sh U wbSource.Radni listovi'dobijte broj redaka i stupaca na listush.AktiviratiActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivirajteiRws = ActiveCell.RowiCols = ActiveCell. stupac'postavite raspon posljednje ćelije na listustrEndRng = sh.Cells (iRws, iCols) .Adresa'postavite izvorni raspon za kopiranjePostavi rngSource = sh.Range ("A1:" & strEndRng)'pronađite zadnji redak na odredišnom listuwbDestination.ActivatePostavite wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell) .OdaberitotRws = ActiveCell.Row'provjerite ima li dovoljno redaka za lijepljenje podatakaAko totRws + rngSource.Rows.Count> wsDestination.Rows.Count ZatimMsgBox "Nema dovoljno redaka za postavljanje podataka na radni list Konsolidacija."Idemo ehZavrši ako'Dodaj redak za lijepljenje u sljedeći red doljeAko je totRws 1 Tada je totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Sljedeći shZavrši akoSljedeća wb'sada zatvorite sve otvorene datoteke osim one koju želiteZa svaku web stranicu U primjeni.Radne knjigeAko wb.Name strDestName i wb.Name "PERSONAL.XLSB" Tadawb.Zatvori NetačnoZavrši akoSljedeća wb'očistite predmete kako biste oslobodili memorijuPostavi wbDestination = NištaPostavi wbSource = NištaPostavi wsDestination = NištaPostavite rngSource = NištaPostavite wb = Ništa'uključite ažuriranje zaslona kada dovršiteApplication.ScreenUpdating = NetačnoIzlaz iz podvEh:MsgBox Err.OpisKraj podm

Kombiniranje svih listova iz svih otvorenih radnih knjiga u jedan radni list u aktivnoj radnoj knjizi

Ako želite prenijeti podatke iz svih drugih otvorenih radnih knjiga u onu u kojoj trenutno radite, možete upotrijebiti ovaj kôd u nastavku.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

PodkombinirajMultipleSheetsToExisting ()Uključeno Greška GoTo eh'deklariraju varijable za držanje potrebnih objekataZatamni wbDestination As WorkbookZatamni wbSource kao radnu knjiguZatamni wsDestination kao radni listDim wb Kao radna bilježnicaDim sh As Radni listDim strSheetName As StringDim strDestName As StringZatamnite iRws kao cijeli brojZatamnite iCols kao cijeli brojZatamni totRws kao cijeli brojDim rngEnd As StringZatamnite izvor kao raspon'postavite aktivni objekt radne knjige za odredišnu knjiguPostavite wbDestination = ActiveWorkbook'dobiti naziv aktivne datotekestrDestName = wbDestination.Name'isključite ažuriranje zaslona kako biste ubrzali stvariApplication.ScreenUpdating = Netačno'prvo stvorite novi odredišni radni list u aktivnoj radnoj knjiziApplication.DisplayAlerts = Netačno'nastavi sljedeću pogrešku u slučaju da list ne postojiUključeno Slijedi nastavak greškeActiveWorkbook.Sheets ("Konsolidacija"). Izbrisati'reset greška zamke za prelazak na zamku pogreške na krajuUključeno Greška GoTo ehApplication.DisplayAlerts = Istina'dodajte novi list u radnu knjiguUz ActiveWorkbookPostavite wsDestination = .Sheets.Add (After: =. Sheets (.Sheets.Count))wsDestination.Name = "Konsolidacija"Završi s'sada prođite kroz svaku od otvorenih radnih knjiga kako biste dobili podatkeZa svaku web stranicu U primjeni.Radne knjigeAko wb.Name strDestName i wb.Name "PERSONAL.XLSB" TadaPostavite wbSource = wbZa svaki sh U wbSource.Radni listovi'dobiti broj redaka u listush.AktiviratiActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivirajteiRws = ActiveCell.RowiCols = ActiveCell. stupacrngEnd = sh.Cells (iRws, iCols) .AdresaPostavi rngSource = sh.Range ("A1:" & rngEnd)'pronađite zadnji redak na odredišnom listuwbDestination.ActivatePostavite wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell) .OdaberitotRws = ActiveCell.Row'provjerite ima li dovoljno redaka za lijepljenje podatakaAko totRws + rngSource.Rows.Count> wsDestination.Rows.Count ZatimMsgBox "Nema dovoljno redaka za postavljanje podataka na radni list Konsolidacija."Idemo ehZavrši ako'Dodajte redak za lijepljenje u sljedeći redak prema dolje ako niste u prvom retkuAko je totRws 1 Tada je totRws = totRws + 1rngSource.Copy Odredište: = wsDestination.Range ("A" & totRws)Sljedeći shZavrši akoSljedeća wb'sada zatvorite sve otvorene datoteke osim one koju želiteZa svaku web stranicu U primjeni.Radne knjigeAko wb.Name strDestName i wb.Name "PERSONAL.XLSB" Tadawb.Zatvori NetačnoZavrši akoSljedeća wb'očistite predmete kako biste oslobodili memorijuPostavi wbDestination = NištaPostavi wbSource = NištaPostavi wsDestination = NištaPostavite rngSource = NištaPostavite wb = Ništa'uključite ažuriranje zaslona kada dovršiteApplication.ScreenUpdating = NetačnoIzlaz iz podvEh:MsgBox Err.OpisKraj podm