In dit artikel zullen we een macro maken om gegevens van alle bladen in de werkmap naar een nieuw blad te kopiëren.
Ruwe gegevens voor dit voorbeeld bestaan uit werknemersgegevens van verschillende afdelingen in verschillende bladen. We willen de gegevens van medewerkers consolideren in één enkel blad.
We hebben de macro "CopyRangeFromMultipleSheets" gemaakt voor de consolidatie van de gegevens. Deze macro kan worden uitgevoerd door op de knop "Gegevens consolideren" te klikken.
Macro maakt een nieuw werkblad en voegt de geconsolideerde gegevens van alle werkbladen in.
Code uitleg
'Looping' door alle bladen om te controleren of 'Master'-blad bestaat.
Voor elke bron in dit werkboek.Werkbladen
Als Source.Name = "Master" Dan
MsgBox "Stamblad bestaat al"
Sluit sub
Stop als
Volgende
Bovenstaande code wordt gebruikt om te controleren of het "Master" -blad in de werkmap bestaat. Als er een "Master" -blad in de werkmap staat, wordt de code afgesloten en wordt er een foutmelding weergegeven.
Source.Range("A1").SpecialCells(xlLastCell).Rij
Bovenstaande code wordt gebruikt om het rijnummer van de laatste cel in het blad te krijgen.
Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow)
Bovenstaande code wordt gebruikt om het opgegeven bereik naar de gedefinieerde cel te kopiëren.
Volg hieronder voor de code:
Sub CopyRangeFromMultipleSheets() 'Variabelen Dim Source As Worksheet Dim Destination As Worksheet declareren Dim SourceLastRow, DestLastRow As Long Application.ScreenUpdating = False 'Door alle bladen bladeren om te controleren of er een "Master"-blad bestaat Voor elke bron in ThisWorkbook.Worksheets If Source.Name = "Master" Dan MsgBox "Stamblad bestaat al" Exit Sub End If Next 'Een nieuw blad invoegen na het "Hoofd" blad Set Destination = Worksheets.Add(after:=Sheets("Main")) Destination.Name = " Master" 'Door alle bladen in de werkmap bladeren voor elke bron in ThisWorkbook.Worksheets 'Consolidatie van gegevens uit het "Hoofd"- en "Master"-blad voorkomen Als Source.Name "Main" en Source.Name "Master" Then SourceLastRow = Source .Range("A1").SpecialCells(xlLastCell).Row Source.Activate If Source.UsedRange.Count> 1 Then DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row If DestLastRow = 1 Dan 'kopiëren van gegevens van het bronblad naar het bestemmingsblad Source.Range("A 1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow) Else Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1)) End If End If End If Next Destination.Activate Application.ScreenUpdating = True End Sub
Als je deze blog leuk vond, deel hem dan met je vrienden op Facebook. Ook kunt u ons volgen op Twitter en Facebook.
We horen graag van u, laat ons weten hoe we ons werk kunnen verbeteren en voor u kunnen verbeteren. Schrijf ons op de e-mailsite
