Wenn Sie mehrere Blätter gleichzeitig bearbeiten und Daten aus jedem Blatt in ein Master-Arbeitsblatt kopieren möchten, sollten Sie diesen Artikel lesen. Wir verwenden die currentregion-Eigenschaft des VBA-Codes, um Daten aus allen Arbeitsblättern in einem einzigen Blatt zu konsolidieren. Diese Eigenschaft ist für viele Vorgänge nützlich, die die Auswahl automatisch erweitern, um den gesamten aktuellen Bereich einzuschließen, z. B. die AutoFormat-Methode. Diese Eigenschaft kann nicht in einem geschützten Arbeitsblatt verwendet werden.
Die Bedingung ist: Jedes Blatt sollte ein ähnliches Format enthalten, d. h. dieselbe Anzahl von Spalten; Wenn wir dasselbe Format verwenden, können wir Daten genau zusammenführen.
Bitte beachten Sie: In diesem Artikel wird die Verwendung von VBA-Code demonstriert; Wenn sich aus irgendeinem Grund die Anzahl der Spalten in einem der Blätter unterscheidet, geben die gesamten zusammengeführten Daten kein genaues Bild wieder. Es wird dringend empfohlen, dieselbe Anzahl von Spalten zu verwenden. Der VBA-Code fügt der Arbeitsmappe ein neues Blatt hinzu und kopiert dann die Daten nach jedem Blatt, ohne es zu überschreiben.
Nehmen wir ein Beispiel von 3 Blättern, nämlich Jan, Feb & März. Im Folgenden sind die Schnappschüsse dieser Blätter:
Um Daten aus allen Blättern in einem Blatt zu kombinieren, müssen wir die folgenden Schritte ausführen, um den VB-Editor zu starten:
- Klicken Sie auf die Registerkarte Entwickler
- Wählen Sie aus der Gruppe Code die Option Visual Basic
- Kopieren Sie den folgenden Code in das Standardmodul
Sub CopyCurrentRegion() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long If SheetExists("Master") = True Then MsgBox "Der Sheet Master existiert bereits" Exit Sub End If Application.ScreenUpdating = False Set DestSh = Worksheets.Add DestSh .Name = "Master" For Every sh In ThisWorkbook.Worksheets 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 bereits vorhanden" 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) Mit 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 Sub Function LastRow(sh As Worksheet) On Error Resume Next 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).Column On Error GoTo 0 End Function Function SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean On Error Resume Next If WB Is Nothing Then Set WB = ThisWorkbook SheetExists = CBool(Len(Sheets(SName).Name)) End Function
Das Makro CopyCurrentRegion ruft die Funktion "SheetExists" auf und prüft, ob es einen Arbeitsblattnamen mit "Master" gibt; Wenn es gefunden wird, tut es nichts, andernfalls fügt es ein neues Arbeitsblatt in die aktive Arbeitsmappe ein und benennt es in "Master" um und kopiert dann Daten aus allen Blättern.
Im Folgenden sind die Snapshots der konsolidierten Daten aufgeführt:
Hinweis: Die Beispielarbeitsmappe enthält ein Master-Arbeitsblatt; Es wird empfohlen, das Master-Arbeitsblatt zu löschen und dann das Makro auszuführen, um zu sehen, wie der VBA-Code funktioniert.
Abschluss:Jetzt haben wir den Code, mit dem wir Daten aus jedem Arbeitsblatt in ein Blatt übertragen können.
Wenn Ihnen unsere Blogs gefallen haben, teilen Sie sie mit Ihren Freunden auf Facebook. Und Sie können uns auch auf Twitter und Facebook folgen.
Wir würden uns freuen, von Ihnen zu hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern, ergänzen oder erneuern und für Sie verbessern können. Schreiben Sie uns auf der E-Mail-Site