Kopieren Sie die Current einer Zelle jedes Blatt in ein Blatt mit VBA in Microsoft Excel
in ein Blatt Wenn Sie mehrere Blätter gleichzeitig bearbeiten und Daten von jedem Blatt in ein Master-Arbeitsblatt kopieren möchten, sollten Sie diesen Artikel lesen. Wir werden die Eigenschaft currentregion des VBA-Codes verwenden, um Daten aus allen Arbeitsblättern in einem einzigen Blatt zu konsolidieren. Diese Eigenschaft ist nützlich für viele Vorgänge, bei denen die Auswahl automatisch auf den gesamten aktuellen Bereich erweitert wird, 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. Die gleiche Anzahl von Spalten; Mit demselben Format können wir Daten genau zusammenführen.
Bitte beachten Sie: In diesem Artikel wird die Verwendung von VBA-Code demonstriert. Wenn sich die Anzahl der Spalten in einem der Blätter aus irgendeinem Grund unterscheidet, ergeben die gesamten zusammengeführten Daten kein genaues Bild. Es wird dringend empfohlen, die gleiche Anzahl von Spalten zu verwenden. Der VBA-Code fügt der Arbeitsmappe ein neues Blatt hinzu und kopiert die Daten nach jedem Blatt, ohne sie zu überschreiben.
Nehmen wir ein Beispiel für 3 Blätter, nämlich Jan, Feb & Mar. Es folgt die Momentaufnahme dieser Blätter:
Um Daten aus allen Blättern zu einem Blatt zu kombinieren, müssen Sie die folgenden Schritte ausführen, um den VB-Editor zu starten:
Klicken Sie auf die Registerkarte Entwickler. Wählen Sie in der Gruppe Code die Option Visual Basic
aus * 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 "The sheet Master already exist"
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)
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 already exist"
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 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
Wenn Ihnen unsere Blogs gefallen haben, teilen Sie sie Ihren Freunden auf Facebook mit. Sie können uns auch auf Twitter und Facebook folgen.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern, ergänzen oder innovieren und für Sie verbessern können. Schreiben Sie uns an [email protected]