VBA：復制並粘貼當前區域中的最后一行

Question

我的目標：
復制每個當前區域中的最后一行並將其粘貼到A26區域中。
因此，A26將是該新區域中的第一個單元。
還切換單元格內容。
請注意，單元格A中的內容=新范圍中的單元格C，
B-> E，C-> B，D-> D，E-> A。
預期結果如下圖所示。

當前代碼中的問題：
我不確定如何復制所有單元格並將其粘貼到相應的col中。
而不是僅將每一行都突出顯示，
當前區域中的某些區域突出顯示了最后兩行。
還有當前代碼，僅復制工作表中的最后一行，因為它在循環中被覆蓋了嗎？

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-> A

要在復制時切換單元格，可以嘗試替換上面的最后一行，即

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

而不是僅將每最后一行突出顯示

除了一個實際原因，我實際上沒有兩個原因，我找不到原因。