Добавить строку, скопировать и вставить в новую строку

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, поэтому со второго запуска макроса Add Row, он не вставляется в добавленные строки.

На снимке экрана показана рабочая таблица.Я всегда хочу добавить строку выше «Чрезвычайные обстоятельства» и вставить формулы в столбцах от D до G в новой строке.

Answer 1

Очевидно, вы просто хотите добавить новую строку ниже последней строки данных.Вы можете использовать Range.Find метод , чтобы найти Contingency в столбце B и вставить строку выше.Обратите внимание, что затем вы можете использовать метод 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, ваш лист остается незащищенным.Так что либо реализуйте обработку ошибок, например…

    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

…, либо защитите свой лист, используя параметр UserInterfaceOnly:=True в методе Worksheet.Protect , чтобы защитить лист от изменений пользователя, но избегайте этоговам нужно снять защиту для действий VBA.(Также см. VBA Excel: Защита листа: UserInterFaceOnly исчез ).