Kopieren Sie die Usedrange jedes Blatt in ein Blatt mit VBA in Microsoft Excel
in ein Blatt Wenn Sie den verwendeten Bereich jedes Arbeitsblatts in das Masterblatt kopieren möchten, sollten Sie diesen Artikel lesen. Wir werden VBA-Code verwenden, um die Daten von jedem Arbeitsblatt zu kopieren und dann in ein anderes Blatt einzufügen, ohne es zu überschreiben.
Das Makro fügt Ihrer Arbeitsmappe ein Blatt mit dem Namen Master hinzu und kopiert die Zellen von jedem Blatt in Ihrer Arbeitsmappe in diesem Arbeitsblatt.
Das erste Makro kopiert normal und das zweite Makro kopiert die Werte. Die Subs des Makros verwenden die folgenden Funktionen. Das Makro funktioniert ohne die Funktionen nicht.
Es folgt die Momentaufnahme der Daten aus Sheet1 und Sheet2:
Wir müssen 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 CopyUsedRange()
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.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 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.UsedRange
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
Nun wird der Makrocode gesetzt; Wir werden das Makro „CopyUsedRange“ ausführen und es wird ein neues Blatt „Master“ einfügen und die Daten von jedem Blatt kopieren.
Schlussfolgerung: * Das Kopieren von Daten aus mehreren Blättern ist eine manuelle Aufgabe. jedoch; Mit dem obigen Code können wir Daten mit einem einzigen Klick auf ein Makro konsolidieren.
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]