• Initiateur de la discussion Initiateur de la discussion Tophe
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

T

Tophe

Guest
Bonsoir à tous,

Je cherche à réaliser une macro qui me refasse le Ctrl+F.
Pas de soucis pour une macro de recherche sur la même feuille ("Find") mais je souhaiterai étendre cette recherche sur toutes les feuilles d'un classeur voir même sur d'autres fichiers.

Une bonne âme est-elle dispo pour mon pb ?

Merci,
Tophe
 
Bonsoir Tophe et toi le Forum,

Voici la procédure qui te permettra d'effectuer ta requête...

Sub Chercher()
'Vériland
'Chercher mot
'http://www.excel-downloads.com/html/French/forum/messages/1_50631_50631.htm

Dim Feuille As Worksheet
Dim Trouve As Range
Dim Valeur As Variant
Dim Boucle As String, Question As String
Dim Total As Long, Nombre As Long
'rentrer le mot à chercher
Question = InputBox("Entrez le mot", "Recherche sur les Feuilles")
'boucle sur feuilles
For Each Feuille In Worksheets
Total = Total + Application.CountIf(Feuille.UsedRange, "=" & Question)
Next Feuille
'rien trouvé
If Total = 0 Then
MsgBox Question & " non trouvé.", vbInformation
Else
' initialise compteur des mots
Nombre = 0
' boucle sur feuille des mots trouvés
For Each Feuille In Worksheets
With Feuille
.Activate
Set Trouve = .Cells.Find(Question)
If Not Trouve Is Nothing Then
Boucle = Trouve.Address
Do
' active cellule trouvée
' et donne la référence
Trouve.Activate
Nombre = Nombre + 1
Valeur = MsgBox("Trouvé " & Question & Chr(10) & Chr(10) & "(" & Nombre & " sur " & Total & ")", vbOKOnly)
If Valeur = vbCancel Then Exit For
Set Trouve = .Cells.FindNext(Trouve)
Loop While Not Trouve Is Nothing And Trouve.Address <> Boucle
End If
End With
Next Feuille
End If
End Sub


Son principe : on rentre un mot et la recherche s'effectue sur l'ensemble des feuilles

A+Veriland.gif


PS : Macro à copier depuis le forum auquel cas tu risques d'avoir les attributs gras du post dedans...
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
19
Affichages
621
Réponses
5
Affichages
310
T
  • Résolu(e)
Microsoft 365 pb effacement macro
Réponses
8
Affichages
617
Themax
T
Réponses
7
Affichages
456
Retour