时间戳

首页 > 解决方案 > 添加行，复制和粘贴到新行

excel - 添加行，复制和粘贴到新行

问题描述

我想插入一行并将上一行中从列'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 列中的公式粘贴到新行中。

标签： excelvba

解决方案

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

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您的工作表仍然不受保护。所以要么实现一个错误处理，比如......</p> 

    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 方法UserInterfaceOnly:=True中的参数保护您的工作表，以保护工作表免受用户更改，但避免您需要为 VBA 操作取消保护它。（另请参阅VBA Excel：工作表保护：UserInterFaceOnly 已消失）。

推荐阅读