Add multi-row range at the end of a Table(Listobject)

[olorin_117]

Hello

I have some data in a worksheet in columns A through E...The rows of data are changing..Some day the range may be A5:E10, another day A5:E30..These data are not in a table (listobject).I am trying to paste them in a table (listobject) in another workbook.I have managed to paste them without calling the listobject method but i am trying to do so..The code I have is this

Private Sub copypastelines()

Dim rng As Range

montpth = ("filepath.xlsx")

Set rng = ActiveSheet.Range("A5:E" & Range("A5").End(xlDown).Row)
rng.Copy

Workbooks.Open (montpth), UpdateLinks:=False
With ActiveWorkbook

next_row = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Sheets("Sheet1").Cells(next_row, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      
End With
      
ActiveWorkbook.Close True

End Sub

I know there is a way to add the data with the listobject.add method but I haven't figure out how
I am using Excel 2019

 

[Domenic]

Try the following macro . . .

Private Sub copypastelines()

    Dim montpth As String
    montpth = "c:\path\filename.xlsx" 'change the path and filename accordingly
    
    Dim rng As Range
    Set rng = Range("A5:E" & Range("A5").End(xlDown).Row)

    Dim wb As Workbook
    Set wb = Workbooks.Open(montpth, UpdateLinks:=False)
    
    Dim newListRow As ListRow
    Set newListRow = wb.Worksheets("Sheet1").ListObjects("Table1").ListRows.Add
    
    rng.Copy
    
    newListRow.Range.PasteSpecial Paste:=xlPasteValues
    
    Application.CutCopyMode = False
          
    wb.Close True

End Sub

Hope this helps!

 

[olorin_117]

Try the following macro . . .

Private Sub copypastelines()

    Dim montpth As String
    montpth = "c:\path\filename.xlsx" 'change the path and filename accordingly
   
    Dim rng As Range
    Set rng = Range("A5:E" & Range("A5").End(xlDown).Row)

    Dim wb As Workbook
    Set wb = Workbooks.Open(montpth, UpdateLinks:=False)
   
    Dim newListRow As ListRow
    Set newListRow = wb.Worksheets("Sheet1").ListObjects("Table1").ListRows.Add
   
    rng.Copy
   
    newListRow.Range.PasteSpecial Paste:=xlPasteValues
   
    Application.CutCopyMode = False
         
    wb.Close True

End Sub

Hope this helps!

This worked perfectly AND found out what I was doing wrong..In the context of pasting my data in the Table, I had to put the

rng.Copy

inside the open workbook-target..I tried 1000 different approaches but with this command outside the scope of the open workbook- target and everytime I got the same error code that I did not know how to work around..Thanks a lot man

 

[Domenic]

Yeah, this line of code . . .

Set newListRow = wb.Worksheets("Sheet1").ListObjects("Table1").ListRows.Add

. . . seems to clear the clipboard. Anyway, glad I could help.

Cheers!