XL 2013 Formules automatisation

Public Sub Conclure()
Dim T As Double, S() As String, M As Double, E As Long
QueryPerformanceCounter Top
T = CDbl(Top - TopDépart) / CDbl(DTop1sec)
SMin = 1: SMax = 1: Visu 1: Me.Height = 54: Me.Caption = "Tirage réussi."
Select Case T
   Case Is < 10: S = Split(Format(T, "000.E+00"), "E"): E = S(1) \ 3: M = S(0) * 10 ^ S(1) * 1000 ^ -E
                  LabFait.Caption = Choose(1 - E, "Dénoué", "Réglé", "Aperçu") & " en " _
      & M & " " & Choose(1 - E, "", "milli", "micro") & "seconde" & IIf(M > 1, "s", "") & "."
   Case Is < 60:  LabFait.Caption = "Dépêtré en " & Int(T * 10 + 0.5) / 10 & " seconde" & "."
   Case Else:     LabFait.Caption = "Achevé en " & DuréeEnClairSec(T) & "."
   End Select
Terminé = True: MessageBeep vbInformation: Décharger.PlanifierDans 5
End Sub

Private Sub RechercheQuoi(Quoi As Variant)
'Application.EnableEvents = False
'Application.ScreenUpdating = False
Dim Sh As Worksheet, Trouve As Range, SvgAdres$, T$, M$, F$, AdresSource$

F$ = ActiveSheet.Name
Select Case F$
  Case "SuivisAppels": AdresSource$ = "A1"
  Case Else: Exit Sub '
End Select

T = "Pas"
'Quoi = Format(Quoi, "0#"" ""##"" ""##"" ""##"" ""##")'< ceci uniquement si tu veux rechercher avec no formaté
'boucle feuilles
For Each Sh In Worksheets
    Set Trouve = Sh.Cells.Find(Quoi, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not Trouve Is Nothing Then
       Sh.Activate: SvgAdres = Trouve.Address
       'n'affiche pas la cellule source
       If Trouve.Address(False, False) <> AdresSource$ Then
       On Error Resume Next
    
       Call Conclure
          If ActiveSheet.Name = "SuivisAppels" Then
          Trouve.Offset(0, -2).Select
          Else
          Trouve.Offset(0, 0).Select
          End If
       
          M$ = "Trouvé !" & vbLf & "Feuille: " & Sh.Name & vbLf & "Adresse: " & Trouve.Address(False, False) & vbLf & vbLf & "Recherche suivant ?"
       
           If ActiveSheet.Name = "SuivisAppels" Then
            ActiveSheet.Unprotect Password:="Krameri"
            Selection.RowHeight = 130
            ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
            ActiveSheet.EnableSelection = xlNoRestrictions
            End If
       
          If MsgBox(M$, vbYesNo, "Recherche de " & Quoi) = vbNo Then Exit Sub 'MsgBox "Recherche arrêtée !", , "Oups":
          T = "Plus "
       End If
       '
       Do 'boucle sur même feuille
         Set Trouve = Sh.Cells.FindNext(Trouve)
         If Trouve Is Nothing Then Exit Do 'en 1'
         If Trouve.Address = SvgAdres Then Exit Do 'si retour à la 1'trouvée exit do feuil.suivante
         T = "Plus ": Trouve.Select
         M$ = "Trouvé !" & vbLf & "Feuille: " & Sh.Name & vbLf & "Adresse: " & Trouve.Address(False, False) & vbLf & vbLf & "Recherche suivant ?"
         If MsgBox(M$, vbYesNo, "Recherche de " & Quoi) = vbNo Then Exit Sub 'MsgBox "Recherche arrêtée !", , "Oups":
       Loop
    End If
Next
If T = "Pas" Then
  MsgBox "Recherche infructueuse !", , "Oups"
Else
  MsgBox "Recherche terminéee !", , "Très bon boulot ..."
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub