添加行，复制和粘贴到新行答案

【问题标题】：Add Row, Copy and Paste into New Row添加行，复制和粘贴到新行
【发布时间】：2020-02-09 11:57:46
【问题描述】：

我想插入一行并将上一行中从“D”列到“G”列的公式复制到新行中，但是每次插入一行时，粘贴需要向下移动1行，D13 ，D14，D15...... 我目前的代码是；

ActiveSheet.Unprotect "password"
Range("B14").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Range("D13:G13").Select
Selection.Copy
Range("D14").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Protect "password", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
    AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, _
    AllowDeletingColumns:=True, AllowDeletingRows:=True
End Sub

目前发生的情况是它总是粘贴到 D14 中，因此从第二次运行 Add Row 宏开始，它不会粘贴到添加的行中。

屏幕截图显示了工作表。我总是想在 Contingency 上方添加一行并将 D 列到 G 列中的公式粘贴到新行中。

【问题讨论】：

那么你想在哪里粘贴而不是 D14？您粘贴行的标准是什么？例如，它是最后一行，还是有其他标准？ • 您的工作表的屏幕截图可能有助于解释它。 • 无论如何，我建议您阅读并将How to avoid using Select in Excel VBA 应用于您的所有代码。
您好，感谢您的快速回复。我可能没有尽我所能解释我的问题。这是我的第一篇文章。
我首先在第 14 行上方添加一行，然后复制 D13:G13 的内容并粘贴到新的第 14 行单元格 D14:G14 中。下次我运行宏时，我想在第 15 行上方插入一行，然后复制 D14:G14 的内容并粘贴到新的第 15 行单元格 D15:G15 中。依此类推。目前，每次我添加一行时，它总是在第 14 行插入，而不是在每次添加一行时向下移动的原始第 14 行上方。是不是更清楚了？
不是真的，我的问题是您如何确定需要在哪一行上方插入新行？您如何（根据哪些标准）找到该行？屏幕截图真的可以帮助我们为您提供帮助。
截图添加到原帖。

标签： excel vba

【解决方案1】：

显然您只想在最后一个数据行下方添加一个新行。您可以使用Range.Find method 在B 列中找到Contingency 并在上方插入一行。请注意，然后您可以使用Range.Offset method 向上移动一行以获取最后一个数据行：

Option Explicit

Public Sub AddNewRowBeforeContingency()
    Dim Ws As Worksheet
    Set Ws = ThisWorkbook.Worksheets("Sheet1") 'define worksheet

    'find last data row (the row before "Contingency")
    Dim LastDataRow As Range 
    On Error Resume Next 'next line throws error if nothing was found
    Set LastDataRow = Ws.Columns("B").Find(What:="Contingency", LookIn:=xlValues, LookAt:=xlWhole).Offset(RowOffset:=-1).EntireRow
    On Error GoTo 0 'don't forget to re-activate error reporting!!!

    If LastDataRow Is Nothing Then
        MsgBox ("Contingency Row not found")
        Exit Sub
    End If

    Ws.Unprotect Password:="password"

    Application.CutCopyMode = False

    LastDataRow.Offset(RowOffset:=1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Intersect(LastDataRow, Ws.Range("D:G")) 'get columns D:G of last data row
        .Copy Destination:=.Offset(RowOffset:=1)
    End With

    Application.CutCopyMode = False

    Ws.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
               AllowFormattingCells:=True, AllowFormattingColumns:=True, _
               AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, _
               AllowDeletingColumns:=True, AllowDeletingRows:=True        
End Sub

请注意，如果找不到任何内容，find 方法会引发错误。您需要捕获该错误并使用If LastDataRow Is Nothing Then 进行测试，以确定是否发现了某些内容。

请注意，如果在 Ws.Unprotect 和 Ws.Protect 之间发生错误，您的工作表仍然不受保护。所以要么实现一个错误处理，比如……

    Ws.Unprotect Password:="password"        
    On Error Goto PROTECT_SHEET

    Application.CutCopyMode = False

    LastDataRow.Offset(RowOffset:=1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Intersect(LastDataRow, Ws.Range("D:G")) 'get columns D:G of last data row
        .Copy Destination:=.Offset(RowOffset:=1)
    End With
    Application.CutCopyMode = False

PROTECT_SHEET:
    Ws.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
               AllowFormattingCells:=True, AllowFormattingColumns:=True, _
               AllowFormattingRows:=True, AllowInsertingHyperlinks:=True, _
               AllowDeletingColumns:=True, AllowDeletingRows:=True

    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub

... 或使用Worksheet.Protect method 中的参数UserInterfaceOnly:=True 保护您的工作表，以保护工作表免受用户更改，但避免您需要取消对VBA 操作的保护。（另请参阅VBA Excel: Sheet protection: UserInterFaceOnly gone）。

【讨论】：