encontrar texto en archivos multiples de excel

[cborboa]

tengo este codigo, necesito que encuentre un texto en los archivos de excel en un folder y despliegue los arhivos que lo tienen

Gracias



Dim iRow
Dim excelfile As String
Dim sheetCount As Integer
Dim datatoFind
Dim xl As Excel.Application


Sub ListFiles()
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
'MsgBox "The name of the active workbook is " & ActiveWorkbook.Name
On Error Resume Next
For Each myFile In mySource.Files
icol = 2
Cells(iRow, icol).Value = myFile.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, icol), Address:=myFile.Path, TextToDisplay:=myFile.Path
icol = icol + 1
iRow = iRow + 1
excelfile = myFile.Path
Call openexcel
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
Sub openexcel()


Set xl = CreateObject("Excel.Application")
Dim w As Workbook
Set w = xl.Workbooks.Open(excelfile)
xl.Visible = True
Call Button1_Click
w.Close False
Set xl = Nothing

End Sub
Sub Button1_Click()
Find_Data
End Sub
Private Sub Find_Data()
Dim counter As Integer
Dim currentSheet As Integer
Dim notFound As Boolean
Dim yesNo As String
notFound = True
On Error Resume Next
currentSheet = ActiveSheet.Index
MsgBox "The name of the active workbook is " & ActiveWorkbook.Name
datatoFind = StrConv(InputBox("Please enter the value to search for"), vbLowerCase)
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.Count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If InStr(1, StrConv(ActiveCell.Value, vbLowerCase), datatoFind) Then
notFound = False
If HasMoreValues(counter) Then
yesNo = MsgBox("Do you want to continue search?", vbYesNo)
If yesNo = vbNo Then
Sheets(counter).Activate
Exit For
End If
Else
Sheets(counter).Activate
Exit For
End If
Sheets(counter).Activate
End If
Next counter
If notFound Then
MsgBox ("Value not found")
Sheets(currentSheet).Activate
End If
End Sub
Private Function HasMoreValues(ByVal sheetCounter As Integer) As Boolean
HasMoreValues = False
Dim str As String
Dim lastRow As Long
Dim lastCol As Long
Dim rRng As Excel.Range
For counter = sheetCounter + 1 To sheetCount
Sheets(counter).Activate
lastRow = ActiveCell.SpecialCells(xlLastCell).Row
lastCol = ActiveCell.SpecialCells(xlLastCell).Column
For vRow = 1 To lastRow
For vCol = 1 To lastCol
str = Sheets(counter).Cells(vRow, vCol).Text
If InStr(1, StrConv(str, vbLowerCase), datatoFind) Then
HasMoreValues = True
Exit For
End If
Next vCol
If HasMoreValues Then
Exit For
End If
Next vRow
If HasMoreValues Then
Sheets(sheetCounter).Activate
Exit For
End If
Next counter
End Function