Microsoft ExcelでVBAを使用して、指定されたシートに複数の領域に範囲をコピーし
この記事では、指定されたシートに複数の領域を結合するためのマクロを作成します。
生データは、名前と年齢を含むいくつかのサンプルデータで構成されています。生データを含む2つの領域があります。 「宛先」シートに両方の領域を結合する必要があります。
「レコードのコピー」ボタンをクリックすると、フォーマットとともに、両方の領域からのデータの結合が行われます。
「値のみをコピー」ボタンをクリックすると、両方の領域からのデータの結合も実行されますが、セルの形式はコピーされません。
コードの説明
For Each Smallrng In Sheets（ “Main”）。Range（ “A9：B13、D16：E20″）。Areas Next Smallrng上記のForEachループは、定義された領域でループするために使用されます。
Set 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]までご連絡ください