Link to home
Create AccountLog in
Avatar of Ted Penner
Ted PennerFlag for United States of America

asked on

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
'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, _
        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


'turn dialog boxes back on
Application.DisplayAlerts = True


'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 = _

End Sub

Open in new window

Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

Link to home
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of Ted Penner


Thank you sir,

I have attached the files I was working from.  We still have the same issue where it doesn't grab them all.  Continued assistance is greatly appreciated.
Link to home
Create an account to see this answer
Signing up is free. No credit card required.
Create Account