将现有行复制到Excel工作表For循环的新行中

Question

我试图在Excel宏中使用以下代码来标识For循环中的某些行（其中第7列的值为“ 1”的行），并在每次迭代中复制该行的内容，在页面顶部附近插入新行，然后将内容粘贴到新行中。但是在插入线上，我不断得到

  

运行时错误'1004'：这将不起作用，因为它将移动工作表中表格中的单元格：

Range(Cells(3, 7).Address(), Cells(lRow, 7).Address()).Select

Dim r5 As Range

With Selection

    For Each r5 In Selection
        If r5.Value = "1" Then
            r5.EntireRow.Select
            Selection.Copy
            Rows(3).Insert
            Rows(3).Select
            Selection.PasteSpecial Paste:=xlValues
         End If
    Next

End With

我去过很多论坛，并尝试过几种插入行的变体（例如ActiveSheet.Rows(3).Insert","Rows(3).EntireRow.Insert），但没有任何效果。请告知。

更新：我找到了一种解决方案，方法是从For循环中删除行插入：首先运行循环以计算需要复制的行，然后使用结果在工作表中插入空行。然后，我运行另一个循环，将每一行复制到一个空行中并对其执行一些操作。不太优雅，但是有效：

Range(Cells(3, 7).Address(), Cells(lRow, 7).Address()).Select

Dim r5 As Range
Dim SP As Long
SP = 0

With Selection

    For Each r5 In Selection
        If r5.Value = "1" Then
            SP = SP + 1
         End If
    Next

End With

Rows("3:" & SP + 2).Insert Shift:=xlDown
Rows("3:" & SP + 2).Interior.Color = rgbLightGreen

Range(Cells(SP + 3, 7).Address(), Cells(lRow + SP + 3, 7).Address()).Select

Dim r6 As Range
Dim Row As Long
r = 3

With Selection

    For Each r6 In Selection
        If r6.Value = "1" Then
            r6.EntireRow.Copy
            Rows(r).PasteSpecial Paste:=xlValues
            Rows(r).Interior.Color = rgbLightGreen
            Cells(r, 4).Value = ""
            Cells(r, 10).Value = "T"
            r = r + 1

         End If
    Next

End With