Als u het gebruikte bereik van elk werkblad naar het hoofdblad wilt kopiëren, moet u dit artikel lezen. We zullen VBA-code gebruiken om de gegevens van elk werkblad te kopiëren en vervolgens in een ander blad te plakken zonder te overschrijven.
De macro voegt een blad met de naam Master toe aan uw werkmap en kopieert de cellen van elk blad in uw werkmap in dit werkblad.
De eerste macro maakt een normale kopie en de tweede macro kopieert de waarden. De subs van de macro gebruiken de onderstaande functies; de macro's werken niet zonder de functies.
Hieronder vindt u de momentopname van gegevens van Blad1 en Blad2:
We moeten 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 CopyUsedRange() 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 ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count> 1 Then Last = LastRow(DestSh) sh.UsedRange.Copy DestSh.Cells(Last + 1, 1 ) End If End If Next Application.ScreenUpdating = True End Sub Sub CopyUsedRangeValues() 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" For Each sh In ThisWorkbook.Worksheets If sh.Name DestSh.Name Then If sh.UsedRange.Count > 1 Then Last = LastRow(DestSh) With sh.UsedRange DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _ .Columns.Count).Value = .Value End With End If End If Next Ap plication.ScreenUpdating = True End Sub Function 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).Row On Error GoTo 0 End Function Function Lastcol (sh As Worksheet) On Error Resume Next Lastcol = sh.Cells .Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase: =False).Kolom bij fout GoTo 0 Functie Functieblad Beëindigt(SName As String, _Optioneel ByVal WB As Workbook) As Boolean On Error Volgende hervatten Als WB niets is, stel dan WB = ThisWorkbook SheetExists = CBool(Len(Sheets(SName) .Naam)) Functie beëindigen
Nu is de macrocode ingesteld; we zullen de macro "CopyUsedRange" uitvoeren en een nieuw blad "Master" invoegen en de gegevens van elk blad kopiëren.
Conclusie:Het kopiëren van gegevens van meerdere bladen is een handmatige taak; echter; met de bovenstaande code kunnen we gegevens consolideren met een enkele klik op een macro.
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