匹配时添加和复制行

Question

我正在使用 Excel 2016 中的宏。我想要的是在包含文本“名称”的行下添加一行，如果是这种情况，请复制其下的行内容。到目前为止我尝试了什么：

Sub InsertNewRow()
    Dim c As Range
    Set Rng = ActiveSheet.Range("A1:H654")
    For dblCounter = Rng.Cells.Count To 1 Step -1
        Set c = Rng(dblCounter)
        If c.Value Like "*Name*" Then
            c.EntireRow.Insert

    End If
    Next dblCounter
End Sub

问题是如何添加新行（参见上面的代码）并将上面行的全部内容复制到其中。

Answer 1

尽量在顶部始终使用Option Explicit，并声明所有变量。

代码

Option Explicit

Sub InsertNewRow()

    Dim c As Range, Rng As Range
    Dim dblCounter As Long

    Set Rng = ActiveSheet.Range("A1:H654")
    For dblCounter = Rng.Cells.Count To 1 Step -1
        Set c = Rng(dblCounter)
        If c.Value Like "*Name*" Then
            c.Offset(1).EntireRow.Insert ' insert a row below
            c.EntireRow.Copy Destination:=Range("A" & c.Row + 1) ' copy the contents from the row above
        End If
    Next dblCounter

End Sub