Kopieren Sie den UsedRange jedes Blatts in ein Blatt mit VBA in Microsoft Excel

Anonim

Wenn Sie den verwendeten Bereich jedes Arbeitsblatts in das Masterblatt kopieren möchten, sollten Sie diesen Artikel lesen. Wir verwenden VBA-Code, um die Daten aus 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 aus jedem Blatt in Ihrer Arbeitsmappe in dieses Arbeitsblatt.

Das erste Makro macht eine normale Kopie und das zweite Makro kopiert die Werte. Die Subs des Makros verwenden die folgenden Funktionen; die Makros funktionieren nicht ohne die Funktionen.

Im Folgenden sehen Sie die Momentaufnahme der Daten aus Sheet1 & 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 "Der Sheet Master existiert bereits" 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 "Der Blattmaster 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) 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 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).Spalte bei Fehler GoTo 0 End Function Function SheetExists(SName As String, _ Optional ByVal WB As Workbook) As Boolean Bei Fehler Fortsetzen Weiter Wenn WB nichts ist Then Set WB = ThisWorkbook SheetExists = CBool(Len(Sheets(SName) .Name)) Ende Funktion 

Jetzt ist der Makrocode festgelegt; Wir werden das Makro „CopyUsedRange“ ausführen und ein neues Blatt „Master“ einfügen und die Daten aus jedem Blatt kopieren.

Abschluss: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 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