一系列带有更多的领域复制到Excel中使用VBA指定的片
在本文中，我们将创建一个宏，用于将多个区域合并到指定的工作表。
原始数据包含一些样本数据，其中包括姓名和年龄。我们有两个包含原始数据的区域。我们希望将这两个区域合并到“目标”表中。
单击“复制记录”按钮将进行两个区域的数据合并以及格式化。
单击“仅复制值”按钮还将对来自两个区域的数据进行合并，但不复制单元格的格式。
代码说明
对于Sheets（“ Main”）。Range（“ A9：B13，D16：E20”）。Areas下一个Smallrng中的每个Smallrng上面的For Each循环用于在定义的区域上循环。
设置DestRange = Sheets（“ Destination”）。Range（“ A”＆LastRow）
上面的代码用于创建要复制数据的最后一个单元格的范围对象。
Smallrng.Copy DestRange上面的代码用于将数据复制到指定的目标。
请遵循以下代码
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
如果您喜欢此博客，请在Facebook和Facebook上与您的朋友分享。
我们很希望收到您的来信，请让我们知道我们如何才能改善我们的工作并使您的工作更好。写信给我们[email protected]