Question

我想插入一行并将公式从“ 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中，因此从第二次运行“添加行”宏起，它就不会粘贴到添加的行中。

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

Answer 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）。

添加行，复制并粘贴到新行

1 个答案: