In diesem Artikel erstellen wir ein Makro für eine Vereinigung mehrerer Bereiche zu einem angegebenen Blatt.
Rohdaten bestehen aus einigen Beispieldaten, darunter Name und Alter. Wir haben zwei Bereiche, die Rohdaten enthalten. Wir wollen eine Vereinigung beider Bereiche zum Blatt „Ziel“.
Wenn Sie auf die Schaltfläche "Datensatz kopieren" klicken, werden die Daten aus beiden Bereichen zusammen mit der Formatierung zusammengeführt.
Wenn Sie auf die Schaltfläche "Nur Wert kopieren" klicken, werden auch die Daten aus beiden Bereichen zusammengeführt, jedoch ohne das Format der Zelle zu kopieren.
Codeerklärung
Für jede kleinere In Sheets("Main").Range("A9:B13,D16:E20").Areas
Nächster Smallrng
Die obige For Each-Schleife wird verwendet, um definierte Bereiche zu durchlaufen.
Set DestRange = Sheets("Destination").Range("A" & LastRow)
Der obige Code wird verwendet, um ein Bereichsobjekt der letzten Zelle zu erstellen, in die wir die Daten kopieren möchten.
Smallrng.Copy DestRange
Der obige Code wird verwendet, um Daten an das angegebene Ziel zu kopieren.
Bitte folgen Sie unten für den Code
Option Explicit Sub CopyMultiArea() 'Variablen deklarieren Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long 'Durchlaufen bestimmter Bereiche für jeden Smallrng In Sheets("Main").Range("A9:B13,D16:E20"). Areas 'Ermitteln der Zeilennummer der letzten Zelle LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1 'Auswählen der Zelle, in die Datensätze kopiert werden müssen Wenn LastRow = 2 Then Set DestRange = Sheets("Destination").Range("A" & LastRow - 1) Else Set DestRange = Sheets("Destination").Range("A" & LastRow) End If 'Datensätze in den angegebenen Zielbereich kopieren Smallrng.Copy DestRange Next Smallrng End Sub Sub CopyMultiAreaValues() 'Variablen deklarieren Dim DestRange As Range Dim Smallrng As Range Dim LastRow As Long 'Durchlaufen bestimmter Bereiche für jede Smallrng In Sheets("Main").Range("A9:B13,D16:E20" ).Areas 'Ermitteln der Zeilennummer der letzten Zelle LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1 With Smallrng 'Wählen der Zelle wo re Kabel müssen kopiert werden If LastRow = 2 Then Set DestRange = Sheets("Destination").Range("A" & LastRow - 1).Resize(.Rows.Count, .Columns.Count) Sonst Set DestRange = Sheets(" Destination").Range("A" & LastRow).Resize(.Rows.Count, .Columns.Count) End If End With 'Zuweisung der Werte von der Quelle zum Ziel DestRange.Value = Smallrng.Value Next Smallrng End Sub
Wenn Ihnen dieser Blog gefallen hat, teilen Sie ihn mit Ihren Freunden auf Facebook. Außerdem können Sie uns auf Twitter und Facebook folgen.
Wir würden uns freuen, von Ihnen zu hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns auf der E-Mail-Site