How to copy rows from one worksheet into a table in another worksheet without overwriting the data

Question

I am looking to copy a row in worksheet called "Updates" to a table in "6.2022 Basis". I have my VBA set up, but I am having trouble getting it to work without it overwriting a row of data in my table. Is there a way to make my VBA add a new row in my table before it pastes? I have a sorting VBA in the table that requires the new row to be included in the table. My table has no blank rows and I need this command button to automatically copy the row selected and paste it (this excel sheet will be used by others and it will be locked for certain functions). Here is my current code

    Private Sub CommandButton3_Click()
Dim rngToCopy As Range
On Error Resume Next
Set rngToCopy = Application.InputBox("Select range in Updates", Type:=8)
If rngToCopy Is Nothing Then Exit Sub
On Error GoTo 0
ThisWorkbook.Worksheets("6.2022 Basis").Activate
Dim rngToPaste As Range
On Error Resume Next
Set rngToPaste = Application.InputBox("Select range to Paste in 6.2022 Basis", Type:=8)
If rngToPaste Is Nothing Then Exit Sub
On Error GoTo 0
rngToPaste.ClearContents
Dim r As Long, c As Long
For r = 1 To rngToCopy.Rows.Count
For c = 1 To rngToCopy.Columns.Count
    If rngToCopy.Cells(r, c) <> "" Then
        rngToPaste.Cells(r, c).Formula = "=" & rngToCopy.Cells(r, c).Address(External:=True)
    End If
Next
Next
End Sub

I appreciate any advice or help!

My new working code is as of 6.27.2022, I am running into a run-time error '438' any advice would be greatly appreciated!

Private Sub CommandButton3_Click()
Dim rngToCopy As Range
On Error Resume Next
Set rngToCopy = Application.InputBox("Select range in Updates", Type:=8)
If rngToCopy Is Nothing Then Exit Sub
On Error GoTo 0

ThisWorkbook.Worksheets("6.2022 Basis").Activate

Dim DataTable As ListObject
Set DataTable = ThisWorkbook.Worksheets("6.2022 Basis").Basis_Table ' Change this to match the name of your table
'alternatively, you can refer to the table by number.
'If there is only one table on the sheet, then you can write ListObjects(1)

Dim r As Long, c As Long
For r = 1 To rngToCopy.Rows.Count
    Dim DataRow As ListRow
    Set DataRow = DataTable.ListRows.Add
    For c = 1 To rngToCopy.Columns.Count
        If rngToCopy.Cells(r, c) <> "" Then
            DataRow.Range.Cells(1, c).Formula = "=" & rngToCopy.Cells(r, c).Address(External:=True)
        End If
    Next
Next

End Sub

Answer 1

To add new rows to the table, you can use ListObject.ListRows.Add. To start, you will need to get the ListObject for your table. You can find this in the Worksheet.ListObjects collection. Find it using its name or index like Worksheet.ListObjects("Table1"). Then once you have the ListObject, you can create new rows and enter data into those new rows. The totals row is automatically shifted down, and the new row is added with the other data rows. The totals will automatically update, but you will need to redo any sorting or filtering that you have on the table.

Private Sub CommandButton3_Click()
    Dim rngToCopy As Range
    On Error Resume Next
    Set rngToCopy = Application.InputBox("Select range in Updates", Type:=8)
    If rngToCopy Is Nothing Then Exit Sub
    On Error GoTo 0
    Set rngToCopy = ThisWorkbook.Worksheets("Updates").Range(rngToCopy.Address)
    
    ThisWorkbook.Worksheets("6.2022 Basis").Activate
    
    Dim DataTable As ListObject
    Set DataTable = ThisWorkbook.Worksheets("6.2022 Basis").ListObjects("Table1") ' Change this to match the name of your table
    'alternatively, you can refer to the table by number.
    'If there is only one table on the sheet, then you can write ListObjects(1)
    
    Dim r As Long, c As Long
    For r = 1 To rngToCopy.Rows.Count
        Dim DataRow As ListRow
        Set DataRow = DataTable.ListRows.Add
        For c = 1 To rngToCopy.Columns.Count
            If rngToCopy.Cells(r, c) <> "" Then
                DataRow.Range.Cells(1, c).Formula = "=" & rngToCopy.Cells(r, c).Address(External:=True)
            End If
        Next
    Next
End Sub