rows disappearing on datasets of over 100,000 when importing with VBA

Question

I have a macro that I use in Excel 2010 to loop through some xls files, extracting the data from each into a xlsm file. There should be about 195,000 rows from across all of the xls files, but after running it I end up with closer to 90,000. If I run it on only a few of the files at once I get the correct number so it seems to be something to do with the volume I'm trying to incorporate, but I understand that an xlsm can handle up to a million rows so that shouldn't be a problem, should it?. I've split the source files into batches in the past but I'd rather avoid doing that if possible. Ultimately, I'm trying to compile a csv to import into a SQL database. If anybody has any suggestions, I'd be very grateful.

Thanks.

PS I've asked about this before a month or so ago but as I'd totally misdiagnosed the issue and was asking about the wrong thing, I'm writing a fresh question so that I don't set people off on the wrong track. I was rightly chastised for not including enough code last time. This is the subroutine which extracts the data:

Sub import_data()

Dim wk As Workbook
Dim shRead As Worksheet, ws As Worksheet
Dim i As Integer
Dim reportLocation As String
Dim report As String
Dim reportList As String
Dim reportArray() As String
Dim shReadLastColumn As Long
Dim shReadLastRow As Long


'generate list of xls to open
reportLocation = "C:\Foo"
report = Dir(reportLocation & "\*.xls")
reportList = ""

Do While Len(report) > 0
    reportList = report & "," & reportList
    report = Dir
Loop

reportArray() = Split(reportList, ",")

'loop through list of xls files
For i = UBound(reportArray) To LBound(reportArray) Step -1

    If reportArray(i) <> "" Then
        
        Set wk = Workbooks.Open(reportLocation & "\" & reportArray(i), ReadOnly:=True)
        Set shRead = wk.Worksheets(1)
        
    
        With shRead
            shReadLastColumn = .Cells(10, shRead.Columns.count).End(xlToLeft).Column
            shReadLastRow = .Cells(shRead.Rows.count, "A").End(xlUp).Row
        End With
   
        'copy list over on to xlsm compilation
        Dim target_row As Long
        Set ws = ThisWorkbook.Worksheets(1)
        If IsEmpty(ws.Cells(1, 1)) Then
            target_row = 1
            shRead.Range(shRead.Cells(10, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy ws.Cells(target_row, 1)
            Else
            target_row = ws.Cells(Rows.count, 1).End(xlUp).Row + 1
            shRead.Range(shRead.Cells(10 + 1, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy ws.Cells(target_row, 1)
        End If

        wk.Activate
        ActiveWorkbook.Close False
    
    End If

    Set wk = Nothing
    Set shRead = Nothing

Next i

End Sub

Thanks for any help!

Answer 1

You appear to have an unqualified reference with missing workbook object for target_row:

target_row = ws.Cells(Rows.count, 1).End(xlUp).Row + 1

which should be

target_row = ws.Cells(ws.Rows.count, 1).End(xlUp).Row + 1

Also, consider using a With block and avoid any Activate or ActiveWorkbook calls:

' WITH BLOCK (no use of ws)
With ThisWorkbook.Worksheets(1)
    If IsEmpty(.Cells(1, 1)) Then
        target_row = 1
        shRead.Range(shRead.Cells(10, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy .Cells(target_row, 1)
    Else
        target_row = .Cells(.Rows.count, 1).End(xlUp).Row + 1
        shRead.Range(shRead.Cells(10 + 1, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy .Cells(target_row, 1)
    End If
End With

' ADJUSTED LINE
wk.Close False

Also, if you only need data without formats, consider range assignment:

With ThisWorkbook.Worksheets(1)
    ...
    target_row = .Cells(.Rows.count, 1).End(xlUp).Row + 1
    .Cells(target_row, target_row + shReadLastRow - 11).Value = shRead.Range( _
        shRead.Cells(10 + 1, 1), shRead.Cells(shReadLastRow, shReadLastColumn) _
    )
    ...
End With