Sao chép một phạm vi có nhiều Khu vực hơn vào một trang tính được chỉ định bằng VBA trong Microsoft Excel

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