Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim wks As Worksheet, cel As Range, lig as long
For Each wks In Worksheets
With wks.Range("a1:c7")
Set cel = .Find("toto", LookIn:=xlFormulas, LookAt:=xlPart)
If Not cel Is Nothing Then
firstAddress = cel.Address
Do
cel.Interior.Color = vbYellow
Set cel = .FindNext(cel)
lig = Feuil1.range("c65536").End(xlup).Row
with Feuil1
.Cells(lig, 3) = wks.name &"!"& cel.address
end with
Loop While Not cel Is Nothing And cel.Address <> firstAddress
End If
End With
Next
End Sub