Excel VBA Application Very Slow with added Volume

Wrote (and borrowed some) a function which opens all the Excel files in a given directory, then pulls data off various sheets within each workbook and returns that data to a single, master file.

Each workbook contains approx 36000 rows of data all on disparate sheets within the file.  Each workbook has the same type of data, in the same cells on each sheet, so locating the data is not a challenge - writing back to the master file in a timely manner is.

When I load up a single file in this routine, the 36000+ rows of data are processed in less than 45 seconds.  When I load up multiple files, the program slows progressively in relation to the number of files loaded in the program at one time.  For example, If I load 5 files, each individual file creeps from 45 sec per to 3 min per.

Any tips for tuning this would be much appreciated.

------------------------------------------------------------------------------------------------


Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer, strWSname As String

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False



    FolderName = "C:\Users\User1\Documents\excel\"
    ' create list of workbooks in foldername
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls")
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    ' get values from each workbook
   
    r = 0
    strWSname = "Front page"
    'populate columns from files
    c = 5
    For i = 1 To wbCount
        r = 6
        c = c + 1
        cValue = GetInfoFromClosedFile(FolderName, wbList(i), strWSname, "A6", "Names")
        Cells(r, c) = cValue    
    Next i
   
    v = 5
    'populate rows of data under columns
    For j = 1 To wbCount
    v = v + 1
   
   For q = 8 To 36038
    cellARef = "A" & q
    strWSname = Range(cellARef).Text
   
    cellBRef = "B" & q
    cellSearch = Replace(Range(cellBRef).Text, "$", "")
   
    cValue = GetInfoFromClosedFile(FolderName, wbList(j), strWSname, cellSearch, "Values")
    Cells(q, v) = cValue

    Next q
    Next j
   
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
    wbName As String, wsName As String, cellRef, callType As String) As Variant
Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function
    'Workbooks.Open (wbPath & "\" & wbName)
    Select Case callType
        Case "Names"
            arg = "'[" & wbName & "]" & _
                    wsName & " '!" & Range(cellRef).Address(True, True, xlR1C1)
        Case "Values"
            arg = "'[" & wbName & "]" & _
                wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    End Select

    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End FunctionStart Free Trial