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!
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