Als u meerdere bladen tegelijk verwerkt en u wilt gegevens van elk blad naar een hoofdwerkblad kopiëren, lees dan dit artikel. We zullen de huidige regio-eigenschap van VBA-code gebruiken om gegevens van alle werkbladen in één blad te consolideren. Deze eigenschap is handig voor veel bewerkingen die de selectie automatisch uitbreiden om het hele huidige gebied op te nemen, zoals de AutoOpmaak-methode. Deze eigenschap kan niet worden gebruikt op een beveiligd werkblad.
De voorwaarde is: elk blad moet een vergelijkbaar formaat hebben, d.w.z. hetzelfde aantal kolommen; met hetzelfde formaat kunnen we nauwkeurig samengevoegde gegevens hebben.
Let op: dit artikel demonstreert het gebruik van VBA-code; als om wat voor reden dan ook het aantal kolommen in een van de bladen verschilt, geven de volledige samengevoegde gegevens geen nauwkeurig beeld. Het wordt sterk aanbevolen om hetzelfde aantal kolommen te gebruiken. De VBA-code voegt een nieuw blad toe aan de werkmap en kopieer en plak de gegevens na elk blad zonder te overschrijven.
Laten we een voorbeeld nemen van 3 bladen, namelijk Jan, Feb & Mar. Hieronder ziet u een momentopname van deze bladen:
Om gegevens van alle bladen in één blad te combineren, moeten we de onderstaande stappen volgen om de VB-editor te starten:
- Klik op het tabblad Ontwikkelaar
- Selecteer in de codegroep Visual Basic
- Kopieer onderstaande code in de standaard module
Sub CopyCurrentRegion() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Dan MsgBox "The sheet Master bestaat al" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" voor elke sh in dit werkboek.Werkbladen If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow(DestSh) sh.Range("A1").CurrentRegion.Copy DestSh. Cells(Last + 1, 1) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyCurrentRegionValues() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "The sheet Master bestaat al" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh.Name = "Master" For Each sh In ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count > 1 Then Last = LastRow(DestSh) With sh.Range("A1").CurrentRegion DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _ .Columns.Count).Value = .Value End With End If End If Next Application.ScreenUpdating = True End Subfunctie LastRow(sh As Worksheet) On Error Hervat volgende LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range ("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False). Rij bij fout GoTo 0 Einde functie Functie Lastcol(sh As Worksheet ) Bij fout Hervatten Volgende Lastcol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns , _ SearchDirection:=xlVorige, _ MatchCase:=False). Kolom bij fout GoTo 0 End Function Function SheetExists (SName As String, _ Optional ByVal WB As Workbook) As Boolean On Error Hervat volgende als WB niets is, stel dan WB = ThisWorkbook in SheetExists = CBool(Len(Sheets(SName).Name)) End Function
CopyCurrentRegion-macro roept de functie "SheetExists" aan en controleert of er een werkbladnaam is met "Master"; indien gevonden, zal het niets doen, anders zal het een nieuw werkblad in de activeworkbook invoegen en het hernoemen naar "Master" en dan zal het gegevens van alle bladen kopiëren.
Hieronder volgen de momentopnamen van geconsolideerde gegevens:
Opmerking: de voorbeeldwerkmap bevat het hoofdwerkblad; er wordt voorgesteld om het hoofdwerkblad te verwijderen en vervolgens de macro uit te voeren om de VBA-code te zien werken.
Conclusie:Nu hebben we de code die we kunnen gebruiken om gegevens van elk werkblad naar één blad over te zetten.
Als je onze blogs leuk vond, deel deze dan met je vrienden op Facebook. En je kunt ons ook volgen op Twitter en Facebook.
We horen graag van je, laat ons weten hoe we ons werk kunnen verbeteren, aanvullen of vernieuwen en het voor jou beter kunnen maken. Schrijf ons op de e-mailsite