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 WorkbookDim path As StringDim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As ObjectDim rowCount As StringDim myRange As StringDim ws As WorksheetDim fRow As LongDim lRow As LongSet ws = ThisWorkbook.Sheets("Raw Scan Output")Application.ScreenUpdating = FalseSet mergeObj = CreateObject("Scripting.FileSystemObject")'change folder path of excel files herepath = 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.FilesFor Each everyObj In filesObjSet bookList = Workbooks.Open(everyObj)'Grab filename from each open fileDim MyName As StringMyName = 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 pointRange("A2:IV" & Range("A65536").End(xlUp).Row).CopyThisWorkbook.Worksheets(2).Activate'Do not change the following column. It's not the same column as aboveRange("A65536").End(xlUp).Offset(1, 1).PasteSpecialApplication.CutCopyMode = False'Paste scan name into Column AWith ws fRow = .Range("A" & .Rows.Count).End(xlUp).RowEnd WithfRow = fRow + 1'Obtain last rowWith 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 IfEnd With'Paste site name to column ARange("A" & fRow & ":" & "A" & lRow).Value = MyName'stop application from showing save dialog boxApplication.DisplayAlerts = FalsebookList.Close'turn dialog boxes back onApplication.DisplayAlerts = TrueNext'resize row heightFor Each r In ActiveWindow.RangeSelection.Rows r.RowHeight = 15Next r'convert sheet2 into tableActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$M$25000"), , xlYes).Name = _ "Table1"End Sub
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.