VBA Multiple Cell Add to Table

[nlemay95]

Hello!!

I have an Excel 2013 file with two worksheets, "Delivery & Quantity" and "Q Entry". The data within the "Delivery & Quantity" sheet is formatted as a table.

What I am attempting to do is take particular fields from the "Q Entry" worksheet and add them into the bottom of the table on the "Delivery & Quantity" sheet by the use of an ActiveX Control button.

Where I have hit a wall is that in my code (below) I can add the one line (row 6) but cannot add more lines from the "Q Entry" sheet.

How do I just repeat this? Or is there another action I can do that essentially does the below but adds a range of rows/columns?

Private Sub CommandButton1_Click()

Dim the_sheet As Worksheet
Dim table_list_object As ListObject
Dim table_object_row As ListRow

Set the_sheet = Sheets("Delivery & Quality")
Set table_list_object = the_sheet.ListObjects(1)
Set table_object_row = table_list_object.ListRows.Add

table_object_row.Range(1, 1).Value = Sheets("Q Entry").Range("A2")

last_row_with_data = the_sheet.Range("A65536").End(xlUp).Row
last_row_with_data = last_row_with_data

the_sheet.Range("B" & last_row_with_data) = Sheets("Q Entry").Range("B6")
the_sheet.Range("C" & last_row_with_data) = Sheets("Q Entry").Range("C6")
the_sheet.Range("D" & last_row_with_data) = Sheets("Q Entry").Range("D6")
the_sheet.Range("E" & last_row_with_data) = Sheets("Q Entry").Range("E6")
the_sheet.Range("F" & last_row_with_data) = Sheets("Q Entry").Range("F6")
the_sheet.Range("I" & last_row_with_data) = Sheets("Q Entry").Range("G6")

End Sub

Thanks for any assistance!