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

If the user is selecting the range to paste... don't select something that's already filled?? — findwindow, Jun 21 '22 at 15:33
Is your "table" an actual Table/Listobject, or just a tabular range? Why offer the user the option to choose a paste destination: wouldn't it be better to just paste at the end of the existing data? — Tim Williams, Jun 21 '22 at 16:21
It would, the set up of my table is rows of values with the totals at the end of the table, so the new copied row needs to be placed into the value rows, get sorted then totaled. — jmowalker, Jun 21 '22 at 16:50

Toddleson · Answer 1 · 2022-06-27T18:38:37.807

0

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

edited Jun 27 '22 at 18:38

answered Jun 21 '22 at 20:11

Toddleson

4,321
1
6
26

Good Morning, I added your new code and I am running into a Run-time error '438'. Do you think you can help me figure out where I messed up? – jmowalker Jun 27 '22 at 14:36
@jmowalker which line causes the error? – Toddleson Jun 27 '22 at 15:52
Set DataTable = ThisWorkbook.Worksheets("6.2022 Basis").Basis_Table – jmowalker Jun 27 '22 at 15:53
@jmowalker If your table is named "Basis_Table" then you should write `Set DataTable = ThisWorkbook.Worksheets("6.2022 Basis").ListObjects("Basis_Table")` – Toddleson Jun 27 '22 at 16:07
That worked! But the data is not copying correctly. It is creating a new row and copying column A correctly but the rest of the row is going to the end of the table in my total row. I have a sorting macro on 6.2022 but I do not think that's what making the data copy weird. Any ideas why it is copying wonky? – jmowalker Jun 27 '22 at 17:31
@jmowalker When you're selecting the range to copy, make sure to select the whole range and not just the first cell. That could be why it only copies "A". As for why it would overwrite the totals row... Is your total row created by the ListObject or are you manually inserting formulas into the last row of the table? – Toddleson Jun 27 '22 at 18:28
It's a total's row, It either copies the row into my last row that already has data or I insert an extra empty row at the end of my table before my total row and the data goes into two rows . – jmowalker Jun 27 '22 at 18:31
@jmowalker I have made a correction to my code, I apologize for the error. Please try it now. `rngToCopy` was not properly set as a range of worksheet "Updates" – Toddleson Jun 27 '22 at 18:38

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

1 Answers1