VBA：現在の領域の最後の行をコピーして貼り付けます

Question

私の目標：すべての現在の領域で最後の行をコピーしてA26領域に貼り付けます。
したがって、A26はその新しい領域の最初のセルになります。
また、セル内容を切り替える。
新しい範囲のセルA =セルCの内容が
B-> E、C-> B、D-> D、E-> Aであることに注意してください。
期待される結果は以下のイメージにあります。

問題が現在のコードにあります：
すべてのセルをコピーしてそれぞれの列に貼り付ける方法がわかりませんでした。
最後の行のみをハイライト表示する代わりに、
現在の領域の一部に最後の2行が強調表示されています。
また、現在のコードは、ループ内で上書きされていたシートの最後の行だけをコピーしますか？

Dim ws As Worksheets 
Dim rng As Range 
Dim r As Long 
Dim wb As Workbook 

Set wb = ThisWorkbook 
For Each ws In wb.Worksheets   
    If ws.Name = "Master" Then 
    For Each rng In ws.UsedRange.SpecialCells(xlCellTypeConstants, 3).Areas 
      r = rng.Cells(rng.Rows.Count, 1).Row 'last row 
     Set rng = ws.Range(Cells(r, "A"), Cells(r, "J")) 'range = last row cells from col A-J 
     rng.Interior.ColorIndex = 3 'highlight that range 
     rng.Copy 
     ws.Range("A26").PasteSpecial xlPasteValues 'paste them all to same sheet A26 
    Next rng 
    End If 
Next ws 
End Sub 

私はまだVBAに新しいです。誰も私に光を当てることはできますか？

Answer 1

rng.Copy 
ws.Range("A26").PasteSpecial xlPasteValues 'paste them all to same sheet A26 

あなたのコードは常に同じ行を上書きします。これを避けるために、あなたはコピー時に細胞を切り替えるには

Dim pasteRow As Long 
pasteRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row + 1 
If pasteRow < 26 Then pasteRow = 26 
ws.Cells(pasteRow, "A").Resize(,rng.Columns.Count).Value = rng.Value 

B-> E、C-> B、D-> D、E->

に上記の文を変更することができ、あなたはだけではなく、それぞれ最後の行を取得するつまり

ws.Cells(pasteRow, "E").Value = rng.Cells(1, "B").Value 
ws.Cells(pasteRow, "B").Value = rng.Cells(1, "C").Value 
ws.Cells(pasteRow, "D").Value = rng.Cells(1, "D").Value 
ws.Cells(pasteRow, "A").Value = rng.Cells(1, "A").Value 

、上記の最後の行を置き換える遊ぶことができます

を強調

私は実際には2つの領域がある以外は、理由がわかりませんでした。