VBA Több Excel fájl egyesítése egyetlen munkafüzetbe

Ez az oktatóanyag megmutatja, hogyan kombinálhat több Excel fájlt egy munkafüzetbe a VBA -ban

Ha egyetlen munkafüzetet szeretne létrehozni számos munkafüzetből a VBA használatával, számos lépést kell követnie.

• Ki kell választania azokat a munkafüzeteket, amelyekből a forrásadatokat szeretné - a forrásfájlokat.
• Ki kell választania vagy létre kell hoznia azt a munkafüzetet, amelybe az adatokat be szeretné helyezni - a Célfájlt.
• Ki kell választania a lapokat a kívánt forrásfájlok közül.
• Meg kell mondania a kódot, hogy hová helyezze az adatokat a Célfájlban.

Az összes munkalap kombinálása az összes nyitott munkafüzetből egy új munkafüzetbe egyéni lapként

Az alábbi kódban meg kell nyitni azokat a fájlokat, amelyekről másolni kell az információkat, mivel az Excel végigmegy a megnyitott fájlokon, és átmásolja az információkat egy új munkafüzetbe. A kód a Személyes makró munkafüzetbe kerül.

Ezek a fájlok az CSAK Excel fájlok, amelyeket meg kell nyitni.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Több kombinált fájl kombinálása ()On Error GoTo eh'deklarálja a változókat a szükséges objektumok tárolásáraDim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource munkalapkéntDim wb Mint munkafüzetDim sh MunkalapkéntDim strSheetName mint karakterláncDim strDestName Mint karakterlánc'kapcsolja ki a képernyőfrissítést a dolgok felgyorsítása érdekébenApplication.ScreenUpdating = Hamis'először hozzon létre új cél munkafüzetetA wbDestination = Workbooks.Add beállítása'kapja meg az új munkafüzet nevét, így kizárja azt az alábbi körbőlstrDestName = wbDestination.Name'most lapozzon át minden megnyitott munkafüzetet az adatok megszerzéséhez, de zárja ki az új könyvet vagy a Személyes makró munkafüzetetMinden wb -ben az alkalmazásban. MunkafüzetekHa wb.Name strDestName És wb.Name "PERSONAL.XLSB" akkorÁllítsa be a wbSource = wb parancsotMinden egyes Sh In wbSource.Worksheetssh.Copy After: = Munkafüzetek (strDestName). Táblázatok (1)Következő shVége HaKövetkező wb'most zárja be az összes megnyitott fájlt, kivéve az új fájlt és a Személyes makró munkafüzetet.Minden wb -ben az alkalmazásban. MunkafüzetekHa wb.Name strDestName És wb.Name "PERSONAL.XLSB" akkorwb. Bezárás HamisVége HaKövetkező wb'távolítsa el az első lapot a cél munkafüzetbőlApplication.DisplayAlerts = HamisTáblázatok ("Sheet1"). TörlésApplication.DisplayAlerts = Igaz'tisztítsa meg a tárgyakat a memória felszabadításáhozSet wbDestination = SemmiSet wbSource = SemmiSet wsSource = SemmiSet wb = Semmi'kapcsolja be a képernyőfrissítést, ha készApplication.ScreenUpdating = HamisKilépés a Subbóleh:MsgBox Err. LeírásEnd Sub

Kattintson a Makró párbeszédpanelre az eljárás Excel -képernyőn történő futtatásához.

Most megjelenik a kombinált fájl.

Ez a kód körbejárta az egyes fájlokat, és átmásolta a lapot egy új fájlba. Ha bármelyik fájlja egynél több lappal rendelkezik - azokat is lemásolja - beleértve azokat a lapokat, amelyeken semmi nincs!

Az összes munkalap kombinálása az összes nyitott munkafüzetből egyetlen munkalapba egy új munkafüzetben

Az alábbi eljárás egyesíti az összes nyitott munkafüzet összes lapjának adatait egy új munkafüzet egyetlen munkalapjába.

Az egyes lapok információi beillesztésre kerülnek a céllapra a munkalap utolsó elfoglalt sorába.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()On Error GoTo eh'deklarálja a változókat a szükséges objektumok tárolásáraDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorkheetDim wb Mint munkafüzetDim sh MunkalapkéntDim strSheetName mint karakterláncDim strDestName Mint karakterláncDim iRws mint egészDim iCols mint egészDim totRws mint egészString befejezése karakterlánckéntDim rngSource As Range'kapcsolja ki a képernyőfrissítést a dolgok felgyorsítása érdekébenApplication.ScreenUpdating = Hamis'először hozzon létre új cél munkafüzetetA wbDestination = Workbooks.Add beállítása'kapja meg az új munkafüzet nevét, így kizárja azt az alábbi körbőlstrDestName = wbDestination.Name'most lapozzon át minden megnyitott munkafüzetet az adatok megszerzéséhezMinden wb -ben az alkalmazásban. MunkafüzetekHa wb.Name strDestName És wb.Name "PERSONAL.XLSB" akkorÁllítsa be a wbSource = wb parancsotMinden egyes Sh In wbSource.Worksheets'kapja meg a munkalap sorainak és oszlopainak számátsh. AktiválásActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktiválásiRws = ActiveCell.RowiCols = ActiveCell.Oszlop'állítsa be a lap utolsó cellájának tartományátstrEndRng = sh.Cells (iRws, iCols). Cím'állítsa be a forrástartományt másolniÁllítsa be az rngSource = sh.Range ("A1:" & strEndRng)'keresse meg a céllap utolsó sorátwbDestination.ActivateA wsDestination = ActiveSheet beállításawsDestination.Cells.SpecialCells (xlCellTypeLastCell). Válassza kitotRws = ActiveCell.Row'ellenőrizze, hogy van -e elegendő sor az adatok beillesztéséhezHa totRws + rngSource.Rows.Count> wsDestination.Rows.Count ThenMsgBox "Nincs elég sor ahhoz, hogy az adatokat a konszolidációs munkalapra helyezze."Menj hátVége Ha'adjon hozzá egy sort, amelyet be kell illesztenie a következő sorbaHa totRws 1 Akkor totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Következő shVége HaKövetkező wb'most zárja be az összes megnyitott fájlt, kivéve a kívánt fájltMinden wb -ben az alkalmazásban. MunkafüzetekHa wb.Name strDestName És wb.Name "PERSONAL.XLSB" akkorwb. Bezárás HamisVége HaKövetkező wb'tisztítsa meg a tárgyakat a memória felszabadításáhozSet wbDestination = SemmiSet wbSource = SemmiSet wsDestination = SemmiSet rngSource = SemmiSet wb = Semmi'kapcsolja be a képernyőfrissítést, ha készApplication.ScreenUpdating = HamisKilépés a Subbóleh:MsgBox Err. LeírásEnd Sub

Az összes munkalap kombinálása az összes nyitott munkafüzetből egyetlen munkalapba egy aktív munkafüzetben

Ha az összes többi nyitott munkafüzet adatait be szeretné hozni abba, amelyikben jelenleg dolgozik, használja ezt a kódot.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()On Error GoTo eh'deklarálja a változókat a szükséges objektumok tárolásáraDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorkheetDim wb Mint munkafüzetDim sh MunkalapkéntDim strSheetName mint karakterláncDim strDestName Mint karakterláncDim iRws mint egészDim iCols mint egészDim totRws mint egészDim rngEnd mint karakterláncDim rngSource As Range'állítsa be a célkönyv aktív munkafüzet -objektumátA wbDestination = ActiveWorkbook beállítása'kapja meg az aktív fájl nevétstrDestName = wbDestination.Name'kapcsolja ki a képernyőfrissítést a dolgok felgyorsítása érdekébenApplication.ScreenUpdating = Hamis'Először hozzon létre új cél munkalapot az aktív munkafüzetbenApplication.DisplayAlerts = Hamis'folytatja a következő hibát, ha a lap nem létezikHiba esetén Folytassa a következőtActiveWorkbook.Sheets ("Konszolidáció"). Törlés'reset hibacsapda, hogy a végén a hiba csapdába lépjenOn Error GoTo ehApplication.DisplayAlerts = Igaz'új lap hozzáadása a munkafüzethezActiveWorkbook segítségévelÁllítsa be a wsDestination = .Sheets.Add (Utána: =. Sheets (.Sheets.Count))wsDestination.Name = "Konszolidáció"Vége ezzel'most lapozzon át minden megnyitott munkafüzetet az adatok megszerzéséhezMinden wb -ben az alkalmazásban. MunkafüzetekHa wb.Name strDestName És wb.Name "PERSONAL.XLSB" akkorÁllítsa be a wbSource = wb parancsotMinden egyes Sh In wbSource.Worksheets'kapja meg a munkalap sorainak számátsh. AktiválásActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktiválásiRws = ActiveCell.RowiCols = ActiveCell.OszloprngEnd = sh.Cells (iRws, iCols). CímÁllítsa be az rngSource = sh.Range ("A1:" & rngEnd)'keresse meg a céllap utolsó sorátwbDestination.ActivateA wsDestination = ActiveSheet beállításawsDestination.Cells.SpecialCells (xlCellTypeLastCell). Válassza kitotRws = ActiveCell.Row'ellenőrizze, hogy van -e elegendő sor az adatok beillesztéséhezHa totRws + rngSource.Rows.Count> wsDestination.Rows.Count ThenMsgBox "Nincs elég sor ahhoz, hogy az adatokat a konszolidációs munkalapra helyezze."Menj hátVége Ha'adjon hozzá egy sort, amelyet be kell illesztenie a következő sorba, ha nem az 1. sorban vanHa totRws 1 Akkor totRws = totRws + 1rngSource.Copy Destination: = wsDestination.Range ("A" & totRws)Következő shVége HaKövetkező wb'most zárja be az összes megnyitott fájlt, kivéve a kívánt fájltMinden wb -ben az alkalmazásban. MunkafüzetekHa wb.Name strDestName És wb.Name "PERSONAL.XLSB" akkorwb. Bezárás HamisVége HaKövetkező wb'tisztítsa meg a tárgyakat a memória felszabadításáhozSet wbDestination = SemmiSet wbSource = SemmiSet wsDestination = SemmiSet rngSource = SemmiSet wb = Semmi'kapcsolja be a képernyőfrissítést, ha készApplication.ScreenUpdating = HamisKilépés a Subbóleh:MsgBox Err. LeírásEnd Sub