VBA Ühendage mitu Exceli faili ühte töövihikusse

See õpetus näitab teile, kuidas ühendada mitu Exceli faili üheks töövihikuks VBA -s

Ühe töövihiku loomine mitmest töövihikust VBA abil nõuab mitmeid samme.

• Peate valima töövihikud, millest soovite lähteandmeid - lähtefailid.
• Peate valima või looma töövihiku, kuhu soovite andmed sisestada - sihtkoha faili.
• Lehed peate valima lähtefailide hulgast, mida vajate.
• Peate koodile ütlema, kuhu andmed sihtkohafaili paigutada.

Kõikide avatud töövihikute kõigi lehtede ühendamine uueks töövihikuks üksikute lehtedena

Allolevas koodis peavad failid, millest teavet kopeerite, olema avatud, kuna Excel vaatab avatud failid läbi ja kopeerib teabe uude töövihikusse. Kood paigutatakse isikliku makro töövihikusse.

Need failid on AINULT Exceli failid, mis peaksid olema avatud.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

AlamkombineerimineMultipleFiles ()Viga GoTo eh'deklareerige muutujad nõutavate objektide hoidmiseksDim wbDestination As WorkbookDim wbSource kui töövihikDim wsSource kui töölehtDim wb TöövihikunaDim sh kui töölehtDim strSheetName kui stringDim strDestName kui string"Lülitage ekraani värskendamine välja, et asju kiirendadaApplication.ScreenUpdating = Vale"looge kõigepealt uus sihtkoha töövihikMäära wbDestination = Töövihikud. Lisa'saate uue töövihiku nime, nii et välistate selle allolevast tsükliststrDestName = wbDestination.NameNüüd lugege andmete hankimiseks kõiki avatud töövihikuid, kuid välistage oma uus raamat või isiklik makro töövihikIga wb jaoks rakenduses. TöövihikudKui wb.Nimi strDestName Ja wb.Name "PERSONAL.XLSB", siisMäära wbSource = wbIga sh kohta wbSource.Worksheetssh. Kopeeri pärast: = Töövihikud (strDestName). Lehed (1)Järgmine shLõpp KuiJärgmine wbsulgege nüüd kõik avatud failid, välja arvatud uus fail ja isiklik makro töövihik.Iga wb jaoks rakenduses. TöövihikudKui wb.Name strDestName Ja wb.Name "PERSONAL.XLSB", siiswb. Sule valeLõpp KuiJärgmine wb'eemaldage leht 1 sihtkoha töövihikustApplication.DisplayAlerts = ValeArvutustabelid ("Leht1"). KustutaApplication.DisplayAlerts = Tõsimälu vabastamiseks puhastage esemedMäära wbDestination = Mitte midagiMäära wbSource = Mitte midagiMäära wsSource = Mitte midagiMäära wb = mitte midagi'kui olete lõpetanud, lülitage ekraani värskendamine sisseApplication.ScreenUpdating = ValeVälju subeh:MsgBoxi viga. KirjeldusEnd Sub

Protseduuri käivitamiseks Exceli ekraanilt klõpsake dialoogiboksil Makro.

Nüüd kuvatakse teie kombineeritud fail.

See kood on igast failist läbi sirvinud ja kopeerinud lehe uude faili. Kui mõnel teie failil on rohkem kui üks leht - kopeerib see ka need - sealhulgas lehed, millel pole midagi!

Kõikide avatud töövihikute kõikide arvutustabelite ühendamine uude töövihikusse ühele töölehele

Allolev protseduur ühendab kõikide avatud töövihikute lehtede teabe uude loodud töövihikusse üheks tööleheks.

Iga lehe teave kleebitakse töölehe viimasel hõivatud real sihtlehele.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

AlamkombineerimineMultipleSheets ()Viga GoTo eh'deklareerige muutujad nõutavate objektide hoidmiseksDim wbDestination As WorkbookDim wbSource kui töövihikDim wsDestination as WorkheetDim wb TöövihikunaDim sh kui töölehtDim strSheetName kui stringDim strDestName kui stringDim iRws täisarvunaDim iCols täisarvunaDim totRws täisarvunaDim strEndRng stringinaDim rngSource As Range"Lülitage ekraani värskendamine välja, et asju kiirendadaApplication.ScreenUpdating = Vale"looge kõigepealt uus sihtkoha töövihikMäära wbDestination = Töövihikud. Lisa'saate uue töövihiku nime, nii et jätate selle allolevast silmusest väljastrDestName = wbDestination.NameNüüd lugege andmete hankimiseks kõiki avatud töövihikuidIga wb jaoks rakenduses. TöövihikudKui wb.Nimi strDestName Ja wb.Name "PERSONAL.XLSB", siisMäära wbSource = wbIga sh kohta wbSource.Worksheets'saada lehe ridade ja veergude arvsh. AktiveeriActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktiveeriiRws = ActiveCell.RowiCols = ActiveCell. Veerg'määrake lehe viimase lahtri vahemikstrEndRng = sh.Cells (iRws, iCols). Aadress'määrake allikavahemik kopeerimiseksMäära rngSource = sh.Range ("A1:" & strEndRng)"otsige sihtlehe viimane ridawbDestination.ActivateMäära wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). ValigetotRws = ActiveCell.Row'kontrollige, kas andmete kleepimiseks on piisavalt riduKui totRws + rngSource.Rows.Count> wsDestination.Rows.Count SiisMsgBox "Andmete koondamiseks töölehele paigutamiseks pole piisavalt ridu."Mine ehLõpp Kui'lisage rida kleepimiseks järgmisele reale allaKui totRws 1 Siis totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Järgmine shLõpp KuiJärgmine wbNüüd sulgege kõik avatud failid, välja arvatud see, mida sooviteIga wb jaoks rakenduses. TöövihikudKui wb.Name strDestName Ja wb.Name "PERSONAL.XLSB", siiswb. Sule valeLõpp KuiJärgmine wbmälu vabastamiseks puhastage esemedMäära wbDestination = Mitte midagiMäära wbSource = Mitte midagiMäära wsDestination = Mitte midagiMäära rngSource = Mitte midagiMäära wb = mitte midagi'kui olete lõpetanud, lülitage ekraani värskendamine sisseApplication.ScreenUpdating = ValeVälju subeh:MsgBoxi viga. KirjeldusEnd Sub

Kõigi avatud töövihikute kõigi lehtede ühendamine aktiivse töövihiku ühele töölehele

Kui soovite tuua kõigi teiste avatud töövihikute teabe sellesse, milles te praegu töötate, saate seda koodi kasutada allpool.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

AlamkombineerimineMultipleSheetsToExisting ()Viga GoTo eh'deklareerige muutujad nõutavate objektide hoidmiseksDim wbDestination As WorkbookDim wbSource kui töövihikDim wsDestination as WorkheetDim wb TöövihikunaDim sh kui töölehtDim strSheetName kui stringDim strDestName kui stringDim iRws täisarvunaDim iCols täisarvunaDim totRws täisarvunaDim rngLõpeta stringinaDim rngSource As Range'määrab sihtraamatu aktiivse töövihiku objektiMäära wbDestination = ActiveWorkbook'saada aktiivse faili nimistrDestName = wbDestination.Name"Lülitage ekraani värskendamine välja, et asju kiirendadaApplication.ScreenUpdating = Vale"looge esmalt aktiivsele töövihikule uus sihtlehtApplication.DisplayAlerts = Vale'jätka järgmist viga juhul, kui lehte pole olemasVea korral Jätka järgmistActiveWorkbook.Sheets ("Konsolideerimine"). Kustuta'lähtestage vea lõks, et minna vea lõksu lõpusViga GoTo ehApplication.DisplayAlerts = Tõsi'lisage töövihikusse uus lehtActiveWorkbookigaMäära wsDestination = .Sheets.Add (Pärast: =. Sheets (.Sheets.Count))wsDestination.Name = "Konsolideerimine"LõpetaNüüd lugege andmete hankimiseks kõiki avatud töövihikuidIga wb jaoks rakenduses. TöövihikudKui wb.Nimi strDestName Ja wb.Name "PERSONAL.XLSB", siisMäära wbSource = wbIga sh kohta wbSource.Worksheets'saada lehe ridade arvsh. AktiveeriActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktiveeriiRws = ActiveCell.RowiCols = ActiveCell. VeergrngEnd = sh. Lahtrid (iRws, iCols). AadressMäära rngSource = sh.Range ("A1:" & rngEnd)"otsige sihtlehe viimane ridawbDestination.ActivateMäära wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). ValigetotRws = ActiveCell.Row'kontrollige, kas andmete kleepimiseks on piisavalt riduKui totRws + rngSource.Rows.Count> wsDestination.Rows.Count SiisMsgBox "Andmete koondamiseks töölehele paigutamiseks pole piisavalt ridu."Mine ehLõpp Kui"lisage rida kleepimiseks järgmisele reale alla, kui te pole reas 1Kui totRws 1 Siis totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Järgmine shLõpp KuiJärgmine wbNüüd sulgege kõik avatud failid, välja arvatud see, mida sooviteIga wb jaoks rakenduses. TöövihikudKui wb.Nimi strDestName Ja wb.Name "PERSONAL.XLSB", siiswb. Sulge valeLõpp KuiJärgmine wbmälu vabastamiseks puhastage esemedMäära wbDestination = Mitte midagiMäära wbSource = Mitte midagiMäära wsDestination = Mitte midagiMäära rngSource = Mitte midagiMäära wb = mitte midagi'kui olete lõpetanud, lülitage ekraani värskendamine sisseApplication.ScreenUpdating = ValeVälju subeh:MsgBoxi viga. KirjeldusEnd Sub