VBA združuje več Excelovih datotek v en delovni zvezek

Ta vadnica vam bo pokazala, kako združiti več datotek Excel v en delovni zvezek v VBA

Če želite ustvariti en sam delovni zvezek iz številnih delovnih zvezkov z uporabo VBA, morate upoštevati več korakov.

• Izbrati morate delovne zvezke, iz katerih želite izvorne podatke - izvorne datoteke.
• Izbrati morate ali ustvariti delovni zvezek, v katerega želite vnesti podatke - ciljno datoteko.
• Morate izbrati liste iz izvornih datotek, ki jih potrebujete.
• Kodi morate povedati, kam shraniti podatke v ciljno datoteko.

Združevanje vseh listov iz vseh odprtih delovnih zvezkov v novega delovnega zvezka kot posameznih listov

V spodnji kodi morajo biti datoteke, iz katerih morate kopirati podatke, odprte, saj bo Excel pregledoval odprte datoteke in podatke kopiral v nov delovni zvezek. Koda je vnesena v delovni zvezek Personal Macro.

Te datoteke so SAMO Excelove datoteke, ki jih je treba odpreti.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineMultipleFiles ()Napaka GoTo eh'deklarirajte spremenljivke za shranjevanje zahtevanih predmetovZatemni wbDestination kot delovni zvezekZatemni wbSource kot delovni zvezekZatemni wsSource kot delovni listDim wb Kot delovni zvezekDim sh kot delovni listZatemni strSheetName kot nizZatemni strDestName kot niz'izklopite posodabljanje zaslona, ​​da pospešite stvariApplication.ScreenUpdating = Napačno'najprej ustvarite nov ciljni delovni zvezekNastavi wbDestination = Delovni zvezki.Dodaj'dobite ime novega delovnega zvezka, da ga izključite iz spodnje zankestrDestName = wbDestination.Name"zdaj poiščite vse odprte delovne zvezke, da dobite podatke, vendar izključite svojo novo knjigo ali osebni delovni zvezek makraZa vsako wb v aplikaciji. Delovni zvezkiČe wb.Name strDestName In wb.Name "PERSONAL.XLSB" PotemNastavite wbSource = wbZa vsak sh V wbSource.Worksheetssh.Copy After: = Delovni zvezki (strDestName). Preglednice (1)Naslednji shKonec ČeNaslednja wb'zdaj zaprite vse odprte datoteke razen nove datoteke in delovnega zvezka Osebni makro.Za vsako wb v aplikaciji. Delovni zvezkiČe wb.Name strDestName In wb.Name "PERSONAL.XLSB" Potemwb.Zapri FalseKonec ČeNaslednja wb„odstranite prvi list iz ciljnega delovnega zvezkaApplication.DisplayAlerts = NapačnoListi ("List1"). IzbrišiApplication.DisplayAlerts = Res'očistite predmete, da sprostite spominNastavi wbDestination = NičNastavi wbSource = NičNastavi wsSource = NičNastavi wb = Nič'vklopite posodabljanje zaslona, ​​ko je končanoApplication.ScreenUpdating = NapačnoZapri podeh:MsgBox Err. OpisEnd Sub

Kliknite pogovorno okno Makro, da zaženete postopek z zaslona Excel.

Zdaj bo prikazana vaša združena datoteka.

Ta koda je prelistala vsako datoteko in list kopirala v novo datoteko. Če ima katera od vaših datotek več kot en list - bo tudi te kopiral - vključno z listi brez ničesar!

Združevanje vseh listov iz vseh odprtih delovnih zvezkov v en sam delovni list v novem delovnem zvezku

Spodnji postopek združuje informacije iz vseh listov v vseh odprtih delovnih zvezkih v en sam delovni list v novem ustvarjenem delovnem zvezku.

Podatki iz vsakega lista so prilepljeni v ciljni list v zadnji zasedeni vrstici na delovnem listu.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()Napaka GoTo eh'deklarirajte spremenljivke za shranjevanje zahtevanih predmetovZatemni wbDestination kot delovni zvezekZatemni wbSource kot delovni zvezekZatemni wsDestination kot delovni listDim wb Kot delovni zvezekDim sh kot delovni listZatemni strSheetName kot nizZatemni strDestName kot nizZatemni iRws kot celo številoZatemni iCols kot celo številoZatemni totRws kot celo številoZatemni strEndRng kot nizZatemni rngVir kot obseg'izklopite posodabljanje zaslona, ​​da pospešite stvariApplication.ScreenUpdating = Napačno'najprej ustvarite nov ciljni delovni zvezekNastavi wbDestination = Delovni zvezki.Dodaj'dobite ime novega delovnega zvezka, da ga izključite iz spodnje zankestrDestName = wbDestination.Name"zdaj poiščite vsak od delovnih zvezkov, odprtih, da dobite podatkeZa vsako wb v aplikaciji. Delovni zvezkiČe wb.Name strDestName In wb.Name "PERSONAL.XLSB" PotemNastavite wbSource = wbZa vsak sh V wbSource.Worksheets'dobite število vrstic in stolpcev na listush.AktivirajActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivirajteiRws = ActiveCell.RowiCols = stolpec ActiveCell'nastavite obseg zadnje celice na listustrEndRng = sh.Cells (iRws, iCols). Naslov'nastavite izvorno območje za kopiranjeNastavi rngSource = sh.Range ("A1:" & strEndRng)'poiščite zadnjo vrstico na ciljnem listuwbDestination.ActivateNastavite wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). IzberitetotRws = ActiveCell.Row'preverite, ali je dovolj vrstic za prilepitev podatkovČe totRws + rngSource.Rows.Count> wsDestination.Rows.Count PotemMsgBox "Ni dovolj vrstic za vnos podatkov na delovni list Konsolidacija."Pojdi ehKonec Če'dodajte vrstico, ki jo želite prilepiti v naslednjo vrstico navzdolČe totRws 1 Potem je totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Naslednji shKonec ČeNaslednja wb"zdaj zaprite vse odprte datoteke, razen tiste, ki jo želiteZa vsako wb v aplikaciji. Delovni zvezkiČe wb.Name strDestName In wb.Name "PERSONAL.XLSB" Potemwb.Zapri FalseKonec ČeNaslednja wb'očistite predmete, da sprostite spominNastavi wbDestination = NičNastavi wbSource = NičNastavi wsDestination = NičNastavi rngSource = NičNastavi wb = Nič'vklopite posodabljanje zaslona, ​​ko je končanoApplication.ScreenUpdating = NapačnoZapri podeh:MsgBox Err. OpisEnd Sub

Združevanje vseh listov iz vseh odprtih delovnih zvezkov v en sam delovni list v aktivnem delovnem zvezku

Če želite podatke iz vseh drugih odprtih delovnih zvezkov vključiti v tistega, v katerem trenutno delate, lahko uporabite spodnjo kodo.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()Napaka GoTo eh'deklarirajte spremenljivke za shranjevanje zahtevanih predmetovZatemni wbDestination kot delovni zvezekZatemni wbSource kot delovni zvezekZatemni wsDestination kot delovni listDim wb Kot delovni zvezekDim sh kot delovni listZatemni strSheetName kot nizZatemni strDestName kot nizZatemni iRws kot celo številoZatemni iCols kot celo številoZatemni totRws kot celo številoZatemni rngEnd As StringZatemni rngVir kot obseg'nastavite aktivni predmet delovnega zvezka za ciljno knjigoNastavite wbDestination = ActiveWorkbook'dobite ime aktivne datotekestrDestName = wbDestination.Name'izklopite posodabljanje zaslona, ​​da pospešite stvariApplication.ScreenUpdating = Napačno'najprej ustvarite nov ciljni delovni list v aktivnem delovnem zvezkuApplication.DisplayAlerts = Napačno'nadaljevanje naslednje napake, če list ne obstajaOn Napaka Nadaljuj NaprejActiveWorkbook.Sheets ("Konsolidacija"). Izbriši'ponastavi past napak, da se premaknete na past napakNapaka GoTo ehApplication.DisplayAlerts = Res'v delovni zvezek dodaj nov listZ ActiveWorkbookNastavi wsDestination = .Sheets.Add (After: =. Sheets (.Sheets.Count))wsDestination.Name = "Konsolidacija"Končaj s"zdaj poiščite vse odprte delovne zvezke, da dobite podatkeZa vsako wb v aplikaciji. Delovni zvezkiČe wb.Name strDestName In wb.Name "PERSONAL.XLSB" PotemNastavite wbSource = wbZa vsak sh V wbSource.Worksheets'dobite število vrstic na listush.AktivirajActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivirajteiRws = ActiveCell.RowiCols = stolpec ActiveCellrngEnd = sh.Cells (iRws, iCols). NaslovNastavi rngSource = sh.Range ("A1:" & rngEnd)'poiščite zadnjo vrstico na ciljnem listuwbDestination.ActivateNastavite wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). IzberitetotRws = ActiveCell.Row'preverite, ali je dovolj vrstic za prilepitev podatkovČe totRws + rngSource.Rows.Count> wsDestination.Rows.Count PotemMsgBox "Ni dovolj vrstic za vnos podatkov na delovni list Konsolidacija."Pojdi ehKonec Če'dodajte vrstico, ki jo želite prilepiti v naslednjo vrstico navzdol, če niste v prvi vrsticiČe totRws 1 Potem je totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Naslednji shKonec ČeNaslednja wb"zdaj zaprite vse odprte datoteke, razen tiste, ki jo želiteZa vsako wb v aplikaciji. Delovni zvezkiČe wb.Name strDestName In wb.Name "PERSONAL.XLSB" Potemwb.Zapri FalseKonec ČeNaslednja wb'očistite predmete, da sprostite spominNastavi wbDestination = NičNastavi wbSource = NičNastavi wsDestination = NičNastavi rngSource = NičNastavi wb = Nič'vklopite posodabljanje zaslona, ​​ko je končanoApplication.ScreenUpdating = NapačnoZapri podeh:MsgBox Err. OpisEnd Sub