Kopieren Sie einen Bereich mit mehr Flächen zu einem bestimmten Blatt mit VBA in Microsoft Excel
einen Bereich mit mehr Bereichen in ein bestimmtes Blatt In diesem Artikel erstellen wir ein Makro für die Vereinigung mehrerer Bereiche zu einem bestimmten Blatt.
Rohdaten bestehen aus einigen Beispieldaten, einschließlich Name und Alter. Wir haben zwei Bereiche, die Rohdaten enthalten. Wir wollen eine Vereinigung beider Bereiche mit dem Blatt „Ziel“.
Durch Klicken auf die Schaltfläche „Datensatz kopieren“ werden die Daten aus beiden Bereichen zusammen mit der Formatierung zusammengeführt.
Durch Klicken auf die Schaltfläche „Nur Wert kopieren“ werden auch Daten aus beiden Bereichen zusammengeführt, ohne jedoch das Format der Zelle zu kopieren.
Code Erklärung
Für jedes Smallrng In Sheets („Main“). Bereich („A9: B13, D16: E20“). Bereiche Next Smallrng Das obige For Each-Loop wird zum Schleifen definierter Bereiche verwendet.
Setze DestRange = Sheets („Destination“). Range („A“ & LastRow)
Der obige Code wird verwendet, um ein Bereichsobjekt der letzten Zelle zu erstellen, in die die Daten kopiert werden sollen.
Smallrng.Copy DestRange Mit dem obigen Code werden Daten an das angegebene Ziel kopiert.
Bitte folgen Sie unten für den Code
Option Explicit
Sub CopyMultiArea()
'Declaring variables
Dim DestRange As Range
Dim Smallrng As Range
Dim LastRow As Long
'Looping through specified areas
For Each Smallrng In Sheets("Main").Range("A9:B13,D16:E20").Areas
'Finding the row number of last cell
LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1
'Selecting the cell where records need to be copy
If LastRow = 2 Then
Set DestRange = Sheets("Destination").Range("A" & LastRow - 1)
Else
Set DestRange = Sheets("Destination").Range("A" & LastRow)
End If
'Copying records to specified destination range
Smallrng.Copy DestRange
Next Smallrng
End Sub
Sub CopyMultiAreaValues()
'Declaring variables
Dim DestRange As Range
Dim Smallrng As Range
Dim LastRow As Long
'Looping through specified areas
For Each Smallrng In Sheets("Main").Range("A9:B13,D16:E20").Areas
'Finding the row number of last cell
LastRow = Sheets("Destination").Range("A1").SpecialCells(xlLastCell).Row + 1
With Smallrng
'Selecting the cell where records need to be copy
If LastRow = 2 Then
Set DestRange = Sheets("Destination").Range("A" & LastRow - 1).Resize(.Rows.Count, .Columns.Count)
Else
Set DestRange = Sheets("Destination").Range("A" & LastRow).Resize(.Rows.Count, .Columns.Count)
End If
End With
'Assigning the values from source to destination
DestRange.Value = Smallrng.Value
Next Smallrng
End Sub
Wenn dir dieser Blog gefallen hat, teile ihn mit deinen Freunden auf Facebook und Facebook.
Wir würden gerne von Ihnen hören, lassen Sie uns wissen, wie wir unsere Arbeit verbessern und für Sie verbessern können. Schreiben Sie uns unter [email protected]