Paste data to last row in table

[FlashNZ]

Hi,
I have a basic Macro that copies some data from one table and pastes it into another table. It works fine except that it pastes the data into the first row of Tbl_Schedule and overwrites the existing data. I want it to paste the new data into the bottom or last row in the table. My Table where I want the data pasted is called Tbl_Schedule on Sheet1.
Appreciate any help.

Sub CopyToSchedule()
'
' CopyToSchedule Macro
'

'
Range(Cells(Selection.Row, 1), Cells(Selection.Row, 7)).Select
Selection.Copy
Sheets("Sheet1").Select
Range("Tbl_Schedule[Inquiry Number]").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
End Sub

 

[Misca]

Welcome to the board!

Here's my suggestion:

Sub WriteValues()

Dim Rng As Range

'Sets the Rng range to be the columns A:G of the selected rows:
Set Rng = Intersect(Selection.EntireRow, Columns("A:G"))

With Sheets("Sheet1")
    With .ListObjects("Tbl_Schedule").DataBodyRange 'The data rows of the table
        'Counts the rows in the table, starts from the next row in the first column and writes the values from the selected rows
        .Cells(.Rows.Count, 1).Offset(1).Resize(Rng.Rows.Count, 7).Value = Rng.Value
    End With
End With

End Sub

The code skips unnecessary selections and calculates the place you want to copy the values to. And write the values instead of actually copying them.

 

[FlashNZ]

Sub WriteValues() Dim Rng As Range 'Sets the Rng range to be the columns A:G of the selected rows: Set Rng = Intersect(Selection.EntireRow, Columns("A:G")) With Sheets("Sheet1") With .ListObjects("Tbl_Schedule").DataBodyRange 'The data rows of the table 'Counts the rows in the table, starts from the next row in the first column and writes the values from the selected rows .Cells(.Rows.Count, 1).Offset(1).Resize(Rng.Rows.Count, 7).Value = Rng.Value End With End With End Sub

Hi Misca,
Thanks, worked perfectly