Memory lack Excel VBA

Question

I have made some subroutines and they worked great in test phase on 5 files, but when I put them to work on real data, that is 600 files, after some time I get this message:

Excel cannot complete this task with available resources. Chose less data or close other applications.

I've googled it and the most I found was application.cutcopymode = false, but in my code I'm not using cut and copy mode, but handle copying with

destrange.Value = sourceRange.Value

And when I go to debug, I mean after error prompt it takes me to this same line of code. If anyone has encountered similar situation, and knows how to solve the problem I would be grateful.

Just to make myself clear I have tried application.cutcopymode = false and it didn't help. I'm opening each of this 600 files, sort by different criteria and from each copy first 100 into new workbook (one after another) and when I finish with one criteria I save and close that new workbook and open new and continue extracting data by different criteria.

If someone is interested to help I also can provide code, but for making question simple I didn't. Any help or suggestion is more than welcome. Thank you.

EDIT:

Here is main sub: (It's purpose is to take from workbook information on how many first rows to copy, because I need once to copy first 100, then 50, then 20, then 10...)

Sub final()
Dim i As Integer
Dim x As Integer    

For i = 7 To 11

    x = ThisWorkbook.Worksheets(1).Range("N" & i).Value        

    Maximum_sub x
    Minimum_sub x
    Above_Average_sub x
    Below_Average_sub x

Next i

End Sub

And here is one of this subs: (Others are basically the same, just sort criteria changes.)

Sub Maximum_sub(n As Integer)
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long
    Dim srt As Sort        

    ' The path\folder location of your files.
    MyPath = "C:\Excel\"    

    ' If there are no adequate files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.txt")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of adequate files
    ' in the search folder.

    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    'get a number: take a top __ from each
    'n = ActiveWorkbook.Worksheets(1).Range("B4").Value

    ' Add a new workbook with one sheet.
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    rnum = 1

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)

            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))


            ' Change this to fit your own needs.

            ' Sorting
            Set srt = mybook.Worksheets(1).Sort

            With srt
                .SortFields.Clear
                .SortFields.Add Key:=Columns("C"), SortOn:=xlSortOnValues, Order:=xlDescending
                .SetRange Range("A1:C18000")
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

            'Deleting nulls
            Do While (mybook.Worksheets(1).Range("C2").Value = "null")
            mybook.Worksheets(1).Rows(2).Delete
            Loop                

            Set sourceRange = mybook.Worksheets(1).Rows("2:" & n + 1)

            SourceRcount = sourceRange.Rows.Count

            Set destrange = BaseWks.Range("A" & rnum)

            BaseWks.Cells(rnum, "A").Font.Bold = True
            BaseWks.Cells(rnum, "B").Font.Bold = True
            BaseWks.Cells(rnum, "C").Font.Bold = True           

            Set destrange = destrange.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)         

            destrange.Value = sourceRange.Value

            rnum = rnum + SourceRcount

            mybook.Close savechanges:=False

        Next FNum
        BaseWks.Columns.AutoFit

    End If

    BaseWks.SaveAs Filename:="maximum_" & CStr(n)
    Activewoorkbook.Close

End Sub

Answer 1

Set sourceRange = mybook.Worksheets(1).Rows("2:" & n + 1) will select all the empty columns after your last column and blow up your memory

To make this more dynamic insert (not tested)

sub try()
dim last_col_ad as string
dim last_col as string

last_col_ad = mybook.Worksheets(1).Range("XFD1").End(xlLeft).Address
last_col = Replace(Cells(1, LastColumn).Address(False, False), "1", "")

Set SourceRange = mybook.Worksheets(1).Range("A2:" & last_col & n + 1)

end sub