Sub FindinXL()
Dim c As Range, sPath As String, sFile As String
Dim fso As Object, objFiles As Object, fcount As Integer
Dim c As Double, strName As String, ws As Worksheet
Dim owbk As Workbook, FindString As String
Application.ScreenUpdating = False
Application.EnableEvents = False
sPath = "D\test" 'Change the loop path
sFile = Dir(sPath & "*.xlsx") 'Change if you wish
If sFil = "" Then
MsgBox "No File found!!!", vbCritical
Exit Sub
End If
FindString = "ABCD" 'Change what's needs to find
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(sPath).Files
fcount = objFiles.Count
On Error GoTo 0 'Error Traping
Set twbk = ActiveWorkbook
sFil = Dir(sPath & "*.xlsx")
Do While sFile <> ""
strName = sPath & sFile
Set owbk = Workbooks.Open(strName)
For Each ws In owbk
With ws.UsedRange
Set c = .Find(FindString, LookIn:=xlValues, LookAt:=xlPart) ' Change as required
If Not c Is Nothing Then _
twbk.Sheets(1).Range("A" & Sheets(1) _
.Range("A" & Rows.Count).End(xlUp).Row) = c.Value 'change as required
End With
Next ws
owbk.Close False
Loop
Set c = Nothing
Set owbk = Nothing
Set twbk = Nothing
Set objFiles = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
