VBA kombinuje viac súborov programu Excel do jedného zošita

Tento tutoriál vám ukáže, ako skombinovať viac súborov programu Excel do jedného zošita vo VBA

Vytvorenie jedného zošita z viacerých zošitov pomocou jazyka VBA vyžaduje dodržanie niekoľkých krokov.

• Musíte vybrať zošity, z ktorých chcete získať zdrojové údaje - zdrojové súbory.
• Musíte vybrať alebo vytvoriť zošit, do ktorého chcete vložiť údaje - cieľový súbor.
• Hárky musíte vybrať zo zdrojových súborov, ktoré požadujete.
• Musíte povedať kódu, kam umiestniť údaje do cieľového súboru.

Kombinácia všetkých hárkov zo všetkých otvorených zošitov do nového zošita ako samostatných listov

V nižšie uvedenom kóde je potrebné, aby boli súbory, z ktorých chcete skopírovať informácie, otvorené, pretože program Excel bude prechádzať otvorenými súbormi a skopíruje informácie do nového zošita. Kód je umiestnený v osobnom zošite makier.

Tieto súbory sú IBA Súbory Excel, ktoré by mali byť otvorené.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineMultipleFiles ()Pri chybe Prejsť eh'Deklarujte premenné, aby držali požadované objektyDim wbCieľ ako pracovný zošitDim wbZdroj ako zošitDim wsSource As worksheetDim wb ako zošitPracovný list Dim sh AsDim strSheetName ako reťazecDim strDestName ako reťazec'vypnite aktualizáciu obrazovky, aby ste všetko urýchliliApplication.ScreenUpdating = False„Najprv vytvorte nový cieľový zošitNastaviť wbDestination = zošity.Pridať'získajte názov nového zošita, aby ste ho vylúčili zo slučky nižšiestrDestName = wbDestination.NameTeraz prechádzajte všetkými otvorenými zošitmi, aby ste získali údaje, ale vylúčte svoju novú knihu alebo osobný zošit makierPre každý wb v aplikácii. Pracovné zošityAk wb.Name strDestName A wb.Name "PERSONAL.XLSB" PotomNastaviť wbSource = wbPre každý priečinok wbSource.Worksheetssh.Copy After: = Zošity (strDestName). Listy (1)Ďalej shKoniec AkDalsie wb'teraz zatvorte všetky otvorené súbory okrem nového súboru a osobného zošita makra.Pre každý wb v aplikácii. Pracovné zošityAk wb.Name strDestName A wb.Name "PERSONAL.XLSB" Potomwb.Close FalseKoniec AkDalsie wb'odstráňte list jeden z cieľového zošitaApplication.DisplayAlerts = FalseTabuľky („List1“). OdstrániťApplication.DisplayAlerts = Pravda'vyčistite predmety, aby sa uvoľnila pamäťNastaviť wbDestination = ničNastaviť wbSource = NičNastaviť wsSource = NičNastaviť wb = nič'po dokončení zapnite aktualizáciu obrazovkyApplication.ScreenUpdating = FalseUkončiť subaha:MsgBox Err.PopisKoniec pod

Kliknutím na dialógové okno Makro spustíte postup z obrazovky programu Excel.

Teraz sa zobrazí váš kombinovaný súbor.

Tento kód prešiel jednotlivými súbormi a skopíroval hárok do nového súboru. Ak má niektorý z vašich súborov viac ako jeden hárok - skopíruje ich aj - vrátane hárkov, na ktorých nie je nič!

Kombinácia všetkých hárkov zo všetkých otvorených zošitov do jedného pracovného hárka v novom zošite

Nasledujúci postup kombinuje informácie zo všetkých hárkov vo všetkých otvorených zošitoch do jedného pracovného hárka v novom vytvorenom zošite.

Informácie z každého hárka sa prilepia do cieľového hárka v poslednom obsadenom riadku pracovného hárka.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()Pri chybe Prejsť eh'Deklarujte premenné, aby držali požadované objektyDim wbCieľ ako pracovný zošitDim wbZdroj ako zošitDim wsCieľový list ako cieľDim wb ako zošitPracovný list Dim sh AsDim strSheetName ako reťazecDim strDestName ako reťazecDim iRws as IntegerDim iCols ako celé čísloDim totRws ako celé čísloDim strEndRng ako reťazecDim rngSource As Range'vypnite aktualizáciu obrazovky, aby ste všetko urýchliliApplication.ScreenUpdating = False„Najprv vytvorte nový cieľový zošitNastaviť wbDestination = zošity.Pridať'získajte názov nového zošita, aby ste ho vylúčili zo slučky nižšiestrDestName = wbDestination.Name'Teraz prejdite všetkými otvorenými zošitmi a získajte údajePre každý wb v aplikácii. Pracovné zošityAk wb.Name strDestName A wb.Name "PERSONAL.XLSB" PotomNastaviť wbSource = wbPre každý priečinok wbSource.Worksheets"Získajte počet riadkov a stĺpcov v hárku."sh.ActivateActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivovaťiRws = ActiveCell.RowiCols = ActiveCell.Column'nastavte rozsah poslednej bunky v hárkustrEndRng = sh.Cells (iRws, iCols) .Address'nastavte zdrojový rozsah na kopírovanieNastaviť rngSource = sh.Range ("A1:" & strEndRng)'nájdite posledný riadok v cieľovom hárkuwbCieľ. AktivovaťNastaviť wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). VybertetotRws = ActiveCell.Row'skontrolujte, či je dostatok riadkov na vloženie údajovAk totRws + rngSource.Rows.Count> wsDestination.Rows.Count ThenMsgBox "Na umiestnenie údajov do pracovného hárka konsolidácie nie je dostatok riadkov."GoTo ehKoniec Ak'pridajte riadok a prilepte ho do nasledujúceho riadkuAk totRws 1 Potom totRws = totRws + 1rngSource.Copy Cieľ: = wsDestination.Range ("A" & totRws)Ďalej shKoniec AkDalsie wbTeraz zatvorte všetky otvorené súbory okrem požadovanéhoPre každý wb v aplikácii. Pracovné zošityAk wb.Name strDestName A wb.Name "PERSONAL.XLSB" Potomwb.Close FalseKoniec AkDalsie wb'vyčistite predmety, aby sa uvoľnila pamäťNastaviť wbDestination = ničNastaviť wbSource = NičNastaviť wsDestination = ničNastaviť rngSource = NičNastaviť wb = nič'po dokončení zapnite aktualizáciu obrazovkyApplication.ScreenUpdating = FalseUkončiť subaha:MsgBox Err.PopisKoniec pod

Kombinácia všetkých hárkov zo všetkých otvorených zošitov do jedného pracovného hárka v aktívnom zošite

Ak chcete preniesť informácie zo všetkých ostatných otvorených zošitov do toho, v ktorom práve pracujete, môžete použiť tento kód nižšie.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()Pri chybe Prejsť eh'Deklarujte premenné, aby držali požadované objektyDim wbCieľ ako pracovný zošitDim wbZdroj ako zošitDim wsCieľový list ako cieľDim wb ako zošitPracovný list Dim sh AsDim strSheetName ako reťazecDim strDestName ako reťazecDim iRws as IntegerDim iCols ako celé čísloDim totRws ako celé čísloDim rngEnd As StringDim rngSource As Range'nastaviť aktívny objekt zošita pre cieľovú knihuNastaviť wbDestination = ActiveWorkbook'získajte názov aktívneho súborustrDestName = wbDestination.Name'vypnite aktualizáciu obrazovky, aby ste všetko urýchliliApplication.ScreenUpdating = False„Najprv vytvorte nový cieľový pracovný hárok vo svojom aktívnom zošiteApplication.DisplayAlerts = False'pokračovať v ďalšej chybe v prípade, že list neexistujePri chybe Pokračovať ďalejActiveWorkbook.Sheets („Konsolidácia“). Odstrániť'resetujte chybovú pascu, aby ste na konci prešli do chybovej pascePri chybe Prejsť ehApplication.DisplayAlerts = Pravda'pridať nový list do zošitaS ActiveWorkbookNastaviť wsDestination = .Sheets.Add (Po: =. Sheets (.Sheets.Count))wsDestination.Name = "Konsolidácia"Ukončiť s'Teraz prejdite všetkými otvorenými zošitmi a získajte údajePre každý wb v aplikácii. Pracovné zošityAk wb.Name strDestName A wb.Name "PERSONAL.XLSB" PotomNastaviť wbSource = wbPre každý priečinok wbSource.Worksheets"Získajte počet riadkov v hárku."sh.ActivateActiveSheet.Cells.SpecialCells (xlCellTypeLastCell). AktivovaťiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells (iRws, iCols). AdresaNastaviť rngSource = sh.Range ("A1:" & rngEnd)'nájdite posledný riadok v cieľovom hárkuwbCieľ. AktivovaťNastaviť wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell). VybertetotRws = ActiveCell.Row'skontrolujte, či je dostatok riadkov na vloženie údajovAk totRws + rngSource.Rows.Count> wsDestination.Rows.Count ThenMsgBox "Na umiestnenie údajov do pracovného hárka konsolidácie nie je dostatok riadkov."GoTo ehKoniec Ak„ak nie ste v riadku 1, pridajte riadok a prilepte ho do nasledujúceho riadkuAk totRws 1 Potom totRws = totRws + 1rngSource.Copy Cieľ: = wsDestination.Range ("A" & totRws)Ďalej shKoniec AkDalsie wbTeraz zatvorte všetky otvorené súbory okrem požadovanéhoPre každý wb v aplikácii. Pracovné zošityAk wb.Name strDestName A wb.Name "PERSONAL.XLSB" Potomwb.Close FalseKoniec AkDalsie wb'vyčistite predmety, aby sa uvoľnila pamäťNastaviť wbDestination = ničNastaviť wbSource = NičNastaviť wsDestination = ničNastaviť rngSource = NičNastaviť wb = nič'po dokončení zapnite aktualizáciu obrazovkyApplication.ScreenUpdating = FalseUkončiť subaha:MsgBox Err.PopisKoniec pod