VBA Copy normal range to bottom of table (not same no. of columns)

Question

I am very new on VBA. I am trying to copy some columns from a range to bottom of a table, they are not in the same columns size, not in the same column order, different in data dimensions too.

The source range looks like (normal excel range A1:C4):

Date	Product1	Product2
01/02/2022	11	13
02/02/2022	10	11
03/02/2022	12	12

The destination table looks like (Table1):

Product	Date	sales no.	sales amount
existing data	existing data	existing data	existing data
existing data	existing data	existing data	existing data
existing data	existing data	existing data	existing data

I am trying to copy sales amount from source range to the bottom of Table1. Copy data should be date, sales amount and repeat product type:

Product	Date	sales no.	sales amount
existing data	existing data	existing data	existing data
existing data	existing data	existing data	existing data
existing data	existing data	existing data	existing data
Product1	01/02/2022		11
Product1	02/02/2022		10
Product1	03/02/2022		12
Product2	01/02/2022		13
Product2	02/02/2022		11
Product2	03/02/2022		12

I did try to this nice (short) script. It run smoothly and fast but for 1 column only.

Set newrow = ListObjects("Table1").ListRows.Add()
ActiveSheet.Range("A2:A" & ActiveSheet.Range("A2").End(xlDown).Row).Copy
newrow.Range.Cells(2).PasteSpecial Paste:=xlPasteValues

Is there any ideal of nice (short) script to do this for the whole copying columns? Really appreciate for your help.

Answer 1

I can only do this by repeating copy column by column with this bulky script, and repeating many rounds for many products in normal range (A1:C4)

With ActiveSheet.Listobjects("Table1")
Set newrow = .ListRows.Add()

'1st round
ActiveSheet.Range("A2:A" & ActiveSheet.Range("A2").End(xlDown).Row).Copy
newrow.Range.Cells(2).PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("B2:B" & ActiveSheet.Range("B2").End(xlDown).Row).Copy
.HeaderRowRange.Find("sales amount").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.HeaderRowRange.Find("Product").End(xlDown).Offset(1, 0).Select
Selection.FormulaR1C1 = "Product1"
Range(Selection, Selection.End(xlDown)).FillDown

'2nd round
Set newrow = .ListRows.Add()
ActiveSheet.Range("A2:A" & ActiveSheet.Range("A2").End(xlDown).Row).Copy
newrow.Range.Cells(2).PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("C2:C" & ActiveSheet.Range("C2").End(xlDown).Row).Copy
.HeaderRowRange.Find("sales amount").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
.HeaderRowRange.Find("Product").End(xlDown).Offset(1, 0).Select
Selection.FormulaR1C1 = "Product2"
Range(Selection, Selection.End(xlDown)).FillDown
End With

Very welcome new ideal or making script more neat and more powerful. Thank you.