Question

我编写了以下代码来识别L列中的更改并复制该行。

如何更改代码以便复制该行及其下方的20行？

Sub CopyRowsAtChangeInValue()
Dim lRow As Long

  For lRow = Cells(Cells.Rows.Count, "L").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "L") <> Cells(lRow - 1, "L") Then
        Rows(CStr(lRow) & ":" & CStr(lRow)).Select
        Selection.Copy
    End If
  Next lRow

End Sub

Answer 1

就像那样......

Sub CopyRowsAtChangeInValue()
Dim lRow As Long

  For lRow = Cells(Cells.Rows.Count, "L").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "L") <> Cells(lRow - 1, "L") Then
        Rows(lRow & ":" & lRow + 20).Copy
    End If
  Next lRow

End Sub

Answer 2

只需在最后一行中添加20行。

Sub CopyRowsAtChangeInValue()
Dim lRow As Long

  For lRow = Cells(Cells.Rows.Count, "L").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "L") <> Cells(lRow - 1, "L") Then
        Rows(CStr(lRow) & ":" & CStr(lRow + 20)).Select
        Selection.Copy
    End If
  Next lRow

End Sub

您也可以通过复制行而不选择来最小化代码。

Rows(CStr(lRow) & ":" & CStr(lRow + 20)).Copy

宏在列L中找到更改 - 如何复制下面的行

2 个答案: