Add Row, Copy and Paste into New Row

Question

I want to insert a row and copy the formulas from columns 'D' through to 'G' in the previous row into the new row, but each time I insert a row, the paste needs to move down 1 row, D13, D14, D15..... The current code I have is;

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

What is happening at the moment is that it always pastes into D14, so from the second time the Add Row macro is run, it is not pasting into the added rows.

The screenshot shows the worksheet. I always want to add a row above Contingency and paste the formulas in columns D through to G in the new row.

Where then do you want to paste instead of D14? What is your criteria for the row to paste in? Eg is it the last row, or is there another criteria? • A screenshot of your sheet might help to explain it. • Regardless I recommend to read and apply How to avoid using Select in Excel VBA to all of your codes. — Pᴇʜ
Hi, Thanks for your quick reply. I may not have explained my issue as well as I could. This is my first post. — R Poulton
What I have is I first add a row above row 14 and then copy the contents of D13:G13 and paste into the new row 14 cells D14:G14. Next time I run the macro, I want to insert a row above row 15 and then copy the contents of D14:G14 and paste into the new row 15 cells D15:G15.and so on. At the moment each time I add a row it always inserts at row 14 and not above the origonal row 14 which moves down each time I add a row. Is that clearer? — R Poulton
Not really, the question I have is how do you determine above which row you need to insert the new row? How (by which criteria) do you find that row? A screenshot would really help us to help you. — Pᴇʜ

Pᴇʜ Pᴇʜ · Accepted Answer · 2018-12-11T09:56:54

Obviously you just want to add a new row below the last data row. You can use the Range.Find method to find the Contingency in column B and insert a row above. Note that you can then use Range.Offset method to move one row upwards to get the last data row:

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

Note that the find method throws an error if nothing can be found. You need to catch that error and test with If LastDataRow Is Nothing Then if something was found or not.

Note that if an error occurs between Ws.Unprotect and Ws.Protect your sheet remains unprotected. So either implement an error handling like …

    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

… or protect your worksheet using the parameter UserInterfaceOnly:=True in the Worksheet.Protect method to protect the sheet from user changes but avoid that you need to unprotect it for VBA actions. (Also refer to VBA Excel: Sheet protection: UserInterFaceOnly gone).

Add Row, Copy and Paste into New Row

1 Answers