Hi All,

I have a macro that takes data from 2 different worksheet tables in a closed workbook and combines them into a single table in an open workbook.

The problem I am having with the code is that:

1) After the 2nd table is added to the first, there a whole bunch of empty rows below it - See attached image (more than 5000 rows, I deleted them the illustrate my problem).
empty space.jpg
2) When I add code to add a 3rd table to the 'new table' it appears below the empty row as seen in the image

How do I get rid of the rows? I think this arises from the use of: 
.Range(.Cells(2, "A"), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).

The full macro below:

Sub CopyDeliveryData()
Dim ReportWbk As Workbook 'workbook with report data
Dim Report As String 'name of file with report data
Dim lastRow As Long 'last row of first table
Dim WS As Worksheet
Dim listObj As ListObject

'Opens source file
Application.DisplayAlerts = False
Application.FileDialog(msoFileDialogFilePicker).Show
Report = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
'/Opens source file


'Source file setup
Set ReportWbk = Workbooks.Open(Report)
For Each WS In ReportWbk.Worksheets
    For Each listObj In WS.ListObjects
        listObj.AutoFilter.ShowAllData
    Next listObj
Next WS
'/Source file setup

'***Delivery data***
ReportWbk.Sheets(1).Cells.Copy
ThisWorkbook.Sheets("Delivery").Activate
Cells(1, 1).Select: ActiveSheet.Paste
' ***Delivery data***

' ***NCD data***
'AMO data grab
ReportWbk.Sheets(2).Cells.Copy
ThisWorkbook.Sheets("NCD").Activate
Cells(1, 1).Select: ActiveSheet.Paste
'/AMO data grab

'LTD data grab
With ReportWbk.Sheets(3)
    .Range(.Cells(2, "A"), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Copy
End With
ThisWorkbook.Sheets("NCD").Activate
With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    .Cells(lastRow, 1).Select
    .Paste
End With

'/LTD data grab

'RMO data grab
With ReportWbk.Sheets(4)
    .Range(.Cells(2, "A"), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Copy
End With
ThisWorkbook.Sheets("NCD").Activate
With ActiveSheet
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    .Cells(lastRow, 1).Select
    .Paste
End With

'/RMO data grab


ReportWbk.Close (False)
End Sub
Thanks all :D