VBA Combineer meerdere Excel-bestanden in één werkmap

Deze tutorial laat je zien hoe je meerdere Excel-bestanden kunt combineren in één werkmap in VBA

Het maken van een enkele werkmap van een aantal werkmappen met VBA vereist een aantal stappen die moeten worden gevolgd.

• U moet de werkmappen selecteren waarvan u de brongegevens wilt - de bronbestanden.
• U moet de werkmap selecteren of maken waarin u de gegevens wilt plaatsen - het bestemmingsbestand.
• U moet de bladen selecteren uit de bronbestanden die u nodig heeft.
• U moet de code vertellen waar de gegevens in het bestemmingsbestand moeten worden geplaatst.

Alle bladen van alle geopende werkmappen combineren tot een nieuwe werkmap als afzonderlijke bladen

In de onderstaande code moeten de bestanden waaruit u de informatie moet kopiëren, geopend zijn, omdat Excel de geopende bestanden doorloopt en de informatie naar een nieuwe werkmap kopieert. De code wordt in het Persoonlijk Macro Werkboek geplaatst.

Deze bestanden zijn de ENIGE Excel-bestanden die moeten worden geopend.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineerMeerdereBestanden()Bij fout Ga naar eh'variabelen declareren om de vereiste objecten vast te houden'Dim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource als werkbladDim wb als werkboekDim sh als werkbladDim strSheetName As StringDim strDestName As String'zet het updaten van het scherm uit om dingen te versnellen'Application.ScreenUpdating = False'maak eerst een nieuwe bestemmingswerkmap'Stel wbDestination = Werkmappen in.Toevoegen'haal de naam van de nieuwe werkmap zodat je deze uitsluit van de onderstaande lus'strDestName = wbDestination.Name'loop nu door elk van de geopende werkmappen om de gegevens te krijgen, maar sluit uw nieuwe boek of de persoonlijke macrowerkmap uit'Voor elke wb In Application.WorkbooksAls wb.Name strDestName en wb.Name "PERSONAL.XLSB" DanStel wbSource = wb inVoor elke sh In wbSource.Werkbladensh.Copy After:=Werkmappen (strDestName). Bladen (1)volgende shStop alsVolgende wb'Sluit nu alle geopende bestanden behalve het nieuwe bestand en de persoonlijke macrowerkmap.Voor elke wb In Application.WorkbooksAls wb.Name strDestName en wb.Name "PERSONAL.XLSB" Danwb.Sluiten FalseStop alsVolgende wb'verwijder blad één uit de doelwerkmap'Application.DisplayAlerts = FalseBladen ("Blad1").VerwijderenApplication.DisplayAlerts = True'ruim de objecten op om het geheugen vrij te maken'Stel wbDestination = Niets inStel wbSource = Niets inStel wsSource = Niets inStel wb = Niets in'zet het updaten van het scherm aan als het klaar is'Application.ScreenUpdating = FalseAfsluiten Subeh:MsgBox Err.BeschrijvingEinde sub

Klik op het dialoogvenster Macro om de procedure vanuit uw Excel-scherm uit te voeren.

Uw gecombineerde bestand wordt nu weergegeven.

Deze code heeft elk bestand doorlopen en het blad naar een nieuw bestand gekopieerd. Als een van uw bestanden meer dan één blad heeft, worden deze ook gekopieerd, inclusief de bladen waar niets op staat!

Alle bladen van alle geopende werkmappen combineren tot een enkel werkblad in een nieuwe werkmap

De onderstaande procedure combineert de informatie van alle bladen in alle geopende werkmappen tot één enkel werkblad in een nieuwe werkmap die wordt gemaakt.

De informatie van elk blad wordt in het bestemmingsblad geplakt op de laatst bezette rij op het werkblad.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineerMeerdere Bladen()Bij fout Ga naar eh'variabelen declareren om de vereiste objecten vast te houden'Dim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination als werkbladDim wb als werkboekDim sh als werkbladDim strSheetName As StringDim strDestName As StringDim iRws als geheel getalDim iCols als geheel getalDim totRws als geheel getalDim strEndRng As StringDim rngBron als bereik'zet het bijwerken van het scherm uit om dingen te versnellen'Application.ScreenUpdating = False'maak eerst een nieuwe bestemmingswerkmap'Stel wbDestination = Werkmappen in.Toevoegen'haal de naam van de nieuwe werkmap zodat je deze uitsluit van de onderstaande lus'strDestName = wbDestination.Name'loop nu door elk van de geopende werkmappen om de gegevens te krijgen'Voor elke wb In Application.WorkbooksAls wb.Name strDestName en wb.Name "PERSONAL.XLSB" DanStel wbSource = wb inVoor elke sh In wbSource.Werkbladen'haal het aantal rijen en kolommen in het blad'sh.ActiverenActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivereniRws = ActiveCell.RijiCols = ActiveCell.Kolom'stel het bereik van de laatste cel in het blad in'strEndRng = sh.Cells(iRws, iCols).Adres'stel het bronbereik in om te kopiëren'Stel rngSource = sh.Range("A1:" & strEndRng) in'zoek de laatste rij in het bestemmingsblad'wbDestination.ActiverenStel wsDestination = ActiveSheet inwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecterentotRws = ActiveCell.Rij'controleer of er genoeg rijen zijn om de gegevens te plakken'Als totRws + rngSource.Rows.Count > wsDestination.Rows.Count DanMsgBox "Er zijn niet genoeg rijen om de gegevens in het consolidatiewerkblad te plaatsen."Ga naar héStop als'voeg een rij toe om in de volgende rij naar beneden te plakken'Als totRws 1 Dan totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" & totRws)volgende shStop alsVolgende wb'sluit nu alle geopende bestanden behalve degene die je wilt'Voor elke wb In Application.WorkbooksAls wb.Name strDestName en wb.Name "PERSONAL.XLSB" Danwb.Sluiten FalseStop alsVolgende wb'ruim de objecten op om het geheugen vrij te maken'Stel wbDestination = Niets inStel wbSource = Niets inStel wsDestination = Niets inStel rngSource = Niets inStel wb = Niets in'zet het updaten van het scherm aan als het klaar is'Application.ScreenUpdating = FalseAfsluiten Subeh:MsgBox Err.BeschrijvingEinde sub

Alle bladen van alle geopende werkmappen combineren tot een enkel werkblad in een actieve werkmap

Als u de informatie van alle andere geopende werkmappen wilt overbrengen naar degene waarin u momenteel werkt, kunt u deze onderstaande code gebruiken.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineerMultipleSheetsToExisting()Bij fout Ga naar eh'variabelen declareren om de vereiste objecten vast te houden'Dim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination als werkbladDim wb als werkboekDim sh als werkbladDim strSheetName As StringDim strDestName As StringDim iRws als geheel getalDim iCols als geheel getalDim totRws als geheel getalDim rngEnd As StringDim rngBron als bereik'stel het actieve werkmapobject in voor het doelboek'Stel wbDestination = ActiveWorkbook in'haal de naam van het actieve bestand'strDestName = wbDestination.Name'zet het bijwerken van het scherm uit om dingen te versnellen'Application.ScreenUpdating = False'maak eerst een nieuw bestemmingswerkblad in uw actieve werkmap'Application.DisplayAlerts = False'Volgende fout hervatten als blad niet bestaat'Bij fout Hervatten volgendeActiveWorkbook.Sheets("Consolidatie").Verwijderen'reset error trap om aan het einde naar de error trap te gaan'Bij fout Ga naar ehApplication.DisplayAlerts = True'voeg een nieuw blad toe aan de werkmap'Met ActiveWorkbookStel wsDestination = .Sheets.Add in (After:=.Sheets(.Sheets.Count))wsDestination.Name = "Consolidatie"Eindigt met'loop nu door elk van de geopende werkmappen om de gegevens te krijgen'Voor elke wb In Application.WorkbooksAls wb.Name strDestName en wb.Name "PERSONAL.XLSB" DanStel wbSource = wb inVoor elke sh In wbSource.Werkbladen'haal het aantal rijen in het blad'sh.ActiverenActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).ActivereniRws = ActiveCell.RijiCols = ActiveCell.KolomrngEnd = sh.Cells(iRws, iCols).AdresStel rngSource = sh.Range("A1:" & rngEnd) in'zoek de laatste rij in het bestemmingsblad'wbDestination.ActiverenStel wsDestination = ActiveSheet inwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecterentotRws = ActiveCell.Rij'controleer of er genoeg rijen zijn om de gegevens te plakken'Als totRws + rngSource.Rows.Count > wsDestination.Rows.Count DanMsgBox "Er zijn niet genoeg rijen om de gegevens in het consolidatiewerkblad te plaatsen."Ga naar héStop als'voeg een rij toe om op de volgende rij naar beneden te plakken als je niet in rij 1 zit'Als totRws 1 Dan totRws = totRws + 1rngSource.Copy Destination:=wsDestination.Range("A" & totRws)volgende shStop alsVolgende wb'sluit nu alle geopende bestanden behalve degene die je wilt'Voor elke wb In Application.WorkbooksAls wb.Name strDestName en wb.Name "PERSONAL.XLSB" Danwb.Sluiten FalseStop alsVolgende wb'ruim de objecten op om het geheugen vrij te maken'Stel wbDestination = Niets inStel wbSource = Niets inStel wsDestination = Niets inStel rngSource = Niets inStel wb = Niets in'zet het updaten van het scherm aan als het klaar is'Application.ScreenUpdating = FalseSluit subeh:MsgBox Err.BeschrijvingEinde sub