Macro to compile data from multiple selected excel files into one Analysed file

[usercenter93]

I have written a Macro that opens the selected file, searches where the error is occured and then places it in the Summary file in the active cell. Its working perfectly but now i want that instead of selecting each file one by one i could select all required files together or i could open one file and it runs till the last file as the file name is in series i.e Motor 21, motor 22 and so on. there is some help givel in this post but i dont know if i could use it.
http://www.mrexcel.com/forum/excel-...ltiple-excel-files-into-one-summary-file.html .

Sub InputData()

Dim fNameAndPath As Variant
Dim wb As Workbook, temporaryWB As Workbook
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, DateCol As String
Dim CumSum As Double, counter As Double, cum As Double
Dim strSheetName As String, CellName As String
Dim lastColumn As Long

Set wb = ThisWorkbook

strSheetName = ActiveSheet.Name
CellName = ActiveCell.Address
cum = Range(CellName).Offset(-1, 2).Value

fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set temporaryWB = Workbooks.Open(fNameAndPath)


Set ws = ActiveSheet
Set oRange = ws.Range("C:C")

SearchString = "10000"

Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False)


If Not aCell Is Nothing Then ' searching codeID string first time

aCell.Select
DateCol = aCell.Offset(0, -2)
counter = aCell.Offset(0, -1)

wb.Worksheets(strSheetName).Range(CellName) = DateCol
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 1) = counter


CumSum = counter + cum
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 2) = CumSum
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 3) = "1000000"
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 4) = "50"


lastColumn = ws.UsedRange.Columns.Count


If InStr(1, ActiveCell.End(xlToRight).Offset(1, 3).Value, "1ms", vbTextCompare) <> 0 Then
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = ActiveCell.End(xlToRight).Offset(1, 3)
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 7) = ActiveCell.End(xlToRight).Offset(1, 4)

Else

wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = Application.InputBox("Enter error", "Dialog box", ActiveCell.End(xlToRight).Offset(1, 3), , , , , 2)
wb.Worksheets(strSheetName).Range(CellName).Offset(0, 7) = Application.InputBox("Enter error", "Dialog box", ActiveCell.End(xlToRight).Offset(1, 4), , , , , 2)

End If
Else
MsgBox SearchString & " not Found"
Exit Sub
End If


temporaryWB.Close savechanges:=False


End Sub

 

[SpillerBD]

See https://msdn.microsoft.com/en-us/library/office/ff834966(v=office.15).aspx
You have the option of selecting multiple files under "GetOpenFileName" procedure.