VBA：复制和粘贴当前区域的最后一行

我的目标：
复制每个当前区域的最后一行并将其粘贴到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 AJ 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

要在复制时切换单元格，您可以在上面的最后一行中replace，即

 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 

而不是仅突出显示最后一行

我找不到原因，除了实际上有两个地方，原因不明。