Combine code

I am unable to easily scrub the data in the sheets that this code references which is why the sheet is not attached.

We have the following code that has a fairly simple function of combining multiple spreadsheets into one.  From what we understand, the limitations of Excel 2010 say that you cannot go over 1,048,576, but yet our code stops at about 70,000 lines.

Assistance in getting us past this is greatly appreciated.

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim path As String
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim rowCount As String
Dim myRange As String

Dim ws As Worksheet
Dim fRow As Long
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Raw Scan Output")

Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
'change folder path of excel files here
path = InputBox("Enter the path to the folder containing the Nessus scans you want to combine.", "Nessus Combiner")
Set dirObj = mergeObj.Getfolder(path)
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

'Grab filename from each open file
Dim MyName As String
MyName = everyObj.Name

'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(2).Activate
 
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 1).PasteSpecial
Application.CutCopyMode = False

'Paste scan name into Column A
With ws
    fRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

fRow = fRow + 1

'Obtain last row
With ws
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
    Else
        lRow = 1
    End If
End With

'Paste site name to column A
Range("A" & fRow & ":" & "A" & lRow).Value = MyName

'stop application from showing save dialog box
Application.DisplayAlerts = False

bookList.Close

'turn dialog boxes back on
Application.DisplayAlerts = True

Next

'resize row height
For Each r In ActiveWindow.RangeSelection.Rows
    r.RowHeight = 15
Next r

'convert sheet2 into table
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$M$25000"), , xlYes).Name = _
         "Table1"

End Sub

Select allOpen in new window