Moteur de recherche sur EXCEL 2007

Sub Recherche(ByVal Quoi As String)
Dim Sh As Worksheet
Dim PlgRes As Range
Dim t
Dim i As Long, j As Long
Dim c As Range
Dim adr1 As String
 
On Error GoTo FinRecherche
Application.ScreenUpdating = 0
Application.EnableEvents = False
 
Msq = UCase("*" & What & "*")
Set PlgRes = Sheets("Accueil").Range("ResultatsRecherche")
PlgRes.Hyperlinks.Delete
PlgRes.ClearContents
PlgRes.Offset(-1).ClearContents
PlgRes.Rows(1).Resize(, 7) = Array("Feuille", "TCPN", "Code Simel", "Désignation", "Codet", "Cdt", "Prix")
Set PlgRes = Sheets("Accueil").Range("ResultatsRecherche")
j = 2
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> PlgRes.Parent.Name Then
With Sh.Range(Sh.Cells(9, 1), Sh.Cells(Sh.Rows.Count, 1)).Resize(, 6)
Set c = .Find(What:=Quoi, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
If Not c Is Nothing Then
adr1 = c.Address
Do
t = Sh.Cells(c.Row, 1).Resize(, 6).Value
PlgRes(j, 1) = Sh.Name
Sh.Hyperlinks.Add PlgRes(j, 2), "", "'" & Sh.Name & "'!" & Sh.Cells(c.Row, 1).Address, "Allez à " & t(1, 1), t(1, 1)
PlgRes(j, 3) = "'" & t(1, 2)
PlgRes(j, 4) = t(1, 3)
PlgRes(j, 5) = t(1, 4)
PlgRes(j, 6) = t(1, 5)
PlgRes(j, 7) = t(1, 6)
j = j + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> adr1
adr1 = ""
End If
End With
End If
Next Sh
Sheets("Accueil").Columns("I:R").Columns.AutoFit
Range("I6:R6").Font.Size = 9
Range("I7:Q37").Font.Size = 8
Range("O7:O37").NumberFormat = "#,##0.0000"
Columns("J:J").HorizontalAlignment = xlLeft
Range("I1").Select
 
FinRecherche:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub