Add new row, copy from cell above

Hi,

I have a macro to add a new row, but now I want to paste the value from the above row.

My code:

Private Sub CommandButton1_Click()

Dim rowNum As Integer
On Error Resume Next
rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
Title:="Add row", Type:=1)
Rows(rowNum & ":" & rowNum).Insert Shift:=xlDown

End Sub

For example, I add a row on row 6. Here I want the date from the row above in the table:

How about this:

Private Sub CommandButton1_Click()
    Dim tbl As ListObject
    Dim row1 As Long
    Dim row2 As Long
    Dim rowNum As Long
    rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
        Title:="Add row", Type:=1)
    Set tbl = Me.ListObjects(1)
    row1 = tbl.Range.Row
    row2 = row1 + tbl.Range.Rows.Count - 1
    If rowNum <= row1 + 1 Or rowNum > row2 + 1 Then
        MsgBox "Row number not valid for table! Please try again.", vbExclamation
    Else
        tbl.ListRows.Add Position:=rowNum - row1
        Cells(rowNum, 1).Value = Cells(rowNum - 1, 1).Value
    End If
End Sub

4 Replies

HansVogelaar

MVP

Jul 11, 2022

Celia9

Try this:

Private Sub CommandButton1_Click()
    Dim rowNum As Long
    rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
        Title:="Add row", Type:=1)
    If rowNum > 0 Then
        Rows(rowNum).Copy
        Rows(rowNum).Insert
        Application.CutCopyMode = False
    End If
End Sub

Celia9

Brass Contributor

Jul 11, 2022

Thanks Hans!

I get a runtime error
It wont work because it would move cells in a table.

I think because it tries to copy the entire row, I only want to copy and paste the cell of the first column in the row above.

HansVogelaar

MVP

Jul 11, 2022

Celia9

How about this:

Private Sub CommandButton1_Click()
    Dim tbl As ListObject
    Dim row1 As Long
    Dim row2 As Long
    Dim rowNum As Long
    rowNum = Application.InputBox(Prompt:="Enter Row Number where you want to add a row:", _
        Title:="Add row", Type:=1)
    Set tbl = Me.ListObjects(1)
    row1 = tbl.Range.Row
    row2 = row1 + tbl.Range.Rows.Count - 1
    If rowNum <= row1 + 1 Or rowNum > row2 + 1 Then
        MsgBox "Row number not valid for table! Please try again.", vbExclamation
    Else
        tbl.ListRows.Add Position:=rowNum - row1
        Cells(rowNum, 1).Value = Cells(rowNum - 1, 1).Value
    End If
End Sub

Forum Discussion

Add new row, copy from cell above

4 Replies

Resources