VBA not pasting into empty row in table - excel

Question

My goal is to copy and paste rows that meet a certain criteria into a table in another workbook.
My VBA works perfectly except for it pastes in the empty cell below the table. Not in the empty cells below the headers within the table.
PS. I know using select is generally frowned upon, but I needed to use fairly basic syntax so that if the next person needs to modify this and is unfamiliar with VBA they can.
Sub Export()
Sheets("Export Format").Select
Cells(13, "D").Calculate
With Range("A1", Cells(Rows.Count, "L").End(xlUp)) 'reference its column A:G cells from row 1 (header) down to last not empty one in column "A"
.AutoFilter Field:=6, Criteria1:="<>0" ' filter referenced cells on 6th column with everything but "0" content
If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy ' copy filtered cells skipping headers
With Workbooks.Open(Filename:="Z:\Tracking\Database.xlsx").Sheets("Sheet1") 'open wanted workbook and reference its wanted sheet
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False 'paste filtered cells in referenced sheet from ist column A first empty cell after last not empty one
.Parent.Close True 'Save and closes referenced workbook
End With
Application.CutCopyMode = False
End If
End With
On Error Resume Next
Sheets("Export Format").ShowAllData 'Clears Filters
On Error GoTo 0
Sheets("Export Format").Select 'Brings back to Main request sheet
End Sub

Answer 1

Try using a property of the table such as InsertRowRange
Sub Export()
Const DBFILE = "Z:\Tracking\Database.xlsx"
Dim wb As Workbook, wbDB As Workbook
Dim ws As Worksheet, tbl As ListObject
Dim rngFilter As Range, x, rng As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Export Format")
x = Application.WorksheetFunction.Subtotal(103, ws.Columns(1))
If x <= 1 Then
ws.Select
Exit Sub
End If
' set filter range
With ws
.Range("D13").Calculate
' column A:L cells from row 1 (header)
' down to last not empty one in column "A"
Set rngFilter = .Range("A1", .Cells(Rows.Count, "L").End(xlUp))
End With
' open wanted workbook and reference its wanted sheet
Set wbDB = Workbooks.Open(DBFILE)
With wbDB.Sheets("Sheet1")
Set tbl = .ListObjects("Table1")
If tbl.InsertRowRange Is Nothing Then
Set rng = tbl.ListRows.Add.Range
Else
Set rng = tbl.InsertRowRange
End If
End With
' filter on 6th column with everything but "0" content
With rngFilter
.AutoFilter Field:=6, Criteria1:="<>0"
' copy filtered cells skipping headers
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
'paste filtered cells in referenced sheet
'from ist column A first empty cell after last not empty one
rng.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
wbDB.Close True 'Save and closes referenced workbook
ws.AutoFilterMode = False
ws.Select 'Brings back to Main request sheet
MsgBox "Ended"
End Sub