Recherche sur plusieurs classeurs
Bonjour,
Suite à mes recherches et au peu de connaissance que j'ai en VBA, je m'adresse à vous pour tenter de résoudre mon problème.
J'ai plusieurs fichiers construit de la même façon, deux onglets et les mêmes tableaux, le second onglet possède des données qui m'intéressent.
Je souhaite avoir un fichier principal et par le biais d'une macro rechercher les informations concernant un mot clé.
La recherche affiche toutes les informations provenant des classeurs excel qui sont dans un dossier.
J'ai réussi à trouver un fichier qui permet de rechercher le nom sur les autres onglets et d'afficher les informations de ce nom, mais est-il possible de rechercher sur d'autres fichiers excel (sans les ouvrir) ?
Seconde question : est-il possible de rajouter sur le nom affiché par la recherche un lien qui permet d'ouvrir le fichier excel d'où provient la donnée ?
Ci-joint le fichier source.
Merci d'avance pour vos réponses.
Cordialement
Je viens de faire une découverte sur un fichier qui permet de chercher un mot dans plusieurs fichiers excel séparés.
Mais il n'affiche pas les données de la ligne, il affiche uniquement si un des fichiers contient ou non le mot recherché.
Il s'agirait de faire un mix entre la récupération des données (premier fichier joint de mon poste) et cette recherche dans les fichiers excel séparés (zip présent dans cette réponse).
Je vais essayer de résoudre le problème, si quelqu'un veut m'aider je ne dis pas non
Merci d'avance.
Cordialement,
C'est bon j'ai trouvé sur des forums anglais, voici le code pour les intéressés.
Enjoy !
Sub SearchWB()
Dim myDir As String, fn As String, ws As Worksheet, r As Range
Dim a(), n As Long, x As Long, myTask As String, ff As String, temp
myDir = "" '<- change path to folder with files to search
If Dir(myDir, 16) = "" Then
MsgBox "No such folder path", 64, myDir
Exit Sub
End If
myTask = InputBox("Enter Customer Name")
If myTask = "" Then Exit Sub
x = Columns.Count
fn = Dir(myDir & "*.xlsx*")
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Do While fn <> ""
With Workbooks.Open(myDir & fn, 0)
For Each ws In .Worksheets
Set r = ws.Cells.Find(myTask, , , 1)
If Not r Is Nothing Then
ff = r.Address
Do
n = n + 1
temp = r.EntireRow.Value
ReDim Preserve temp(1 To 1, 1 To x)
ReDim Preserve a(1 To n)
a(n) = temp
Set r = ws.Cells.FindNext(r)
Loop While ff <> r.Address
End If
Next
.Close False
End With
fn = Dir
Loop
With ThisWorkbook.Sheets(1).Rows(1)
.CurrentRegion.ClearContents
If n > 0 Then
.Resize(n).Value = _
Application.Transpose(Application.Transpose(a))
Else
MsgBox "Not found", , myTask
End If
End With
End Sub