To find in all the worksheets of all the workbooks in a directory/ Drive and copy

[tameen42]

I have a problem that my data is saved on various Excel workbooks in D-Drive of my hard disk. I want to have macro that will help me to find a specific word (lets say " Dhoom" ) anywhere in any workbook (and on any sheet of that work book) and than copy the entire row of that work sheet and paste it on a particular work book (work sheet). I would be thankful if someone can help me in this regard.

[ragulduy]

Sub macro_find_all_wbs(dir_path As String, search_text As String)
Dim fso, fol, fil, wb1, wb2, sh1, sh2, fnd_rng, count_row
Set wb1 = ActiveWorkbook
Set sh1 = wb1.ActiveSheet
Set fso = CreateObject("Scripting.filesystemobject")
Set fol = fso.getfolder(dir_path)
For Each fil In fol.Files
    Set wb2 = Workbooks.Open(fil)
    For Each sh2 In wb2.Sheets
        Set fnd_rng = sh2.Cells.Find(search_text)
        Do Until fnd_rng Is Nothing Or rnd_rng.Row < count_row
            fnd_rng.EntireRow.Copy sh1.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            count_row = fnd_rng.Row
            Set fnd_rng = sh2.Cells.FindNext(rnd_rng)
        Loop
    Next
Next
End Sub

Something like that perhaps?

[tameen42]

Dear Yudlagar
It doesnt work. As i dont know where to give my input word, which i wanna find through all workbooks.

[ragulduy]

Sorry, use it like this:

sub macro_1()
  call macro_find_all_wbs("C:\path","Searchtext")
end sub

Sub macro_find_all_wbs(dir_path As String, search_text As String)
Dim fso, fol, fil, wb1, wb2, sh1, sh2, fnd_rng, count_row
Set wb1 = ActiveWorkbook
Set sh1 = wb1.ActiveSheet
Set fso = CreateObject("Scripting.filesystemobject")
Set fol = fso.getfolder(dir_path)
For Each fil In fol.Files
    Set wb2 = Workbooks.Open(fil)
    For Each sh2 In wb2.Sheets
        Set fnd_rng = sh2.Cells.Find(search_text)
        Do Until fnd_rng Is Nothing Or rnd_rng.Row < count_row
            fnd_rng.EntireRow.Copy sh1.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            count_row = fnd_rng.Row
            Set fnd_rng = sh2.Cells.FindNext(rnd_rng)
        Loop
    Next
Next
End Sub

[tameen42]

Dear Yudlagar

This time the code works a little better, i mean it is bringing some data...but it does not bring the required cells (containing the desired words) nor it brings all of its row etc.
i just need to find any specific word say " Dhoom" or " Max" etc. anywhere in a workbook and copy the entire row of that cell to my desired place.
Thnx

[tameen42]

dear cant anyone help me in this regard anymore?