Microsoft 365 Gros problème de ralentissement au lancement d'un inputbox

Public Sub BoutonRecherche()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    With Rows(6)
        If ActiveSheet.FilterMode Then .AutoFilter
        With .Columns("A").Interior
            .Pattern = xlSolid: .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0:  .PatternTintAndShade = 0
        End With
    End With
   
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    With Range("A7:Y" & Lastrow)
        .Columns("A:U").ClearFormats
        .Columns("A").RowHeight = 40
        .Columns("W").ClearFormats
        .Columns("J").NumberFormat = "General"
        .Columns("Y").NumberFormat = "General"
    End With
    Sheets("copieappels").Rows.Hidden = False

'   Je ne vois pas l'utilité du bloc ci-dessous tout au moins dans l'exemple fourni
'    With Sheets("format-numero")
'        .Visible = True
'        .Activate
'        With [H3]
'            .Select
'            On Error Resume Next
'                ActiveSheet.PasteSpecial Format:="Texte", Link:=False, DisplayAsIcon:=False
'            On Error GoTo 0
'            NoValidCars = " .-/;,:_"
'            For i = 1 To Len(NoValidCars)
'                .Replace Mid(NoValidCars, i, 1), vbNullString, xlPart
'            Next
'
'            If .Value > 999999999# Then .Value = .Value
'            If .Value > 100000000# And .Value < 1000000000# Then .Value = 33 & .Value
'
'            .Copy
'        End With
'    End With

'----------------------------------------------
    Recherche_youky
    ClearClipboard1 ' ?
'----------------------------------------------

If [as1] = "Haut Bas" Then 'est sur le n°" as1 est dans "CopieAppels"
    ActiveWindow.ScrollRow = Selection.Row
    Selection.Copy
    [H1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   ' [J1].FormulaR1C1 = "N° Client"
    With [Aw2:aw20000]
        .FormulaR1C1 = "=IF(OR(R1C8=RC[-42],R1C8=RC[-41]),1,"""")"
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        .Rows.Hidden = True
        On Error Resume Next
            .SpecialCells(xlCellTypeConstants, 1).EntireRow.Hidden = False
        On Error GoTo 0
        .ClearContents
    End With
    [H1].ClearContents
    Cells(ActiveCell.Row, 1).Select
End If
' Neutralisé car pas de shape dans l'onglet
'Masque boutons si N° dans feuille SuivisAppels
If ActiveSheet.Name = "CopiesAppels" Then
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ActiveSheet.Range("g2:g" & Range("S65536").End(xlUp).Row).SpecialCells(xlVisible).Select
    ActiveCell.Select
    Dim x As Range
    Set x = Sheets("SuivisAppels").Range("g7:h20000").Find(ActiveCell, , xlValues, xlPart, , , False)
    If Not x Is Nothing Then 'si trouve
        ActiveSheet.Shapes("CopieAppels_Button 1").Visible = False
        ActiveSheet.Shapes("CopieAppels_Flèche vers le bas 9").Visible = False
        [S1] = "Ci-dessous vos commentaires :" & Chr(10) & _
        "Votre N° est également dans votre feuille ""SuivisAppels""" & Chr(10) & _
        "Allez dans votre feuille pour le traiter"
        End
    Else
        ActiveSheet.Shapes("CopieAppels_Button 1").Visible = True
        ActiveSheet.Shapes("CopieAppels_Flèche vers le bas 9").Visible = True
           [S1] = "La ligne de ce N° n'est pas ou plus dans ""SuivisAppels"". Pour la réintégrer :" & Chr(10) & _
           "1 - Si plusieurs lignes sont affichées pour le même n°, Choisissez en cliquant dans une cellule de la ligne du dernier appel" & Chr(10) & _
           "2 - Clic sur bouton ""Réintègrez votre Appel"", la ligne sera transférée en dernière ligne"
        'MsgBox ("IMPORTANT : Si vous quittez CopieAppels avant réintégration, vous devrez refaire votre recherche pour retrouver votre ligne" & nbcel)
        CreateObject("Wscript.shell").Popup "Si vous quittez CopieAppels avant réintégration," & Chr(10) & _
        "vous devrez refaire votre recherche pour retrouver votre ligne", 1, "IMPORTANT :"
    End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
'Application.Calculation = xlAutomatic
End Sub
Sub Bloquefeuilles()
End Sub

Sub Recherche_youky()
Dim Trouve As Boolean
Titre = "Recherche Youki"
Application.ScreenUpdating = True

Onglets = Array("SuivisAppels", "CopieAppels", "RendezVous", "NPA")
Targets = Array("G:H", "G:H", "H:I", "G:H")

With Sheets("format-numero"): .[H3] = "": .Visible = False: End With

No = InputBox("Cherche N° Client :" & vbLf & _
              "      - Si pas de n°," & vbLf & _
              "            - ou erreur n°," & vbLf & _
              "                  Recommencez !", "Recherche")
If No <> vbNullString Then
    For i = 0 To UBound(Onglets)
        With Sheets(Onglets(i)).UsedRange.Columns(Targets(i))
            Set C = .Find(No, LookAt:=xlPart)
            If Not C Is Nothing Then
                Trouve = True
                Do
                    .Parent.Activate
                    Select Case Onglets(i)
                        Case "CopieAppels": C.RowHeight = 50
                        Case "SuivisAppels"
                            Rows(6).Copy
                            Rows(C.Row).PasteSpecial Paste:=xlPasteFormats
                            C.RowHeight = 200
                    End Select
                    C.Select
                    ActiveWindow.ScrollRow = C.Row
   
                    If MsgBox(C & " : OK dans " & Onglets(i) & vbLf & vbLf & _
                        "Cellule - ligne :  " & C.Address & vbLf & vbLf & _
                        "Continuer la recherche ?", vbQuestion + vbYesNo, Titre) = vbNo _
                    Then Exit For
                   
                    If firstAddress = "" Then firstAddress = C.Address
                    Set C = .FindNext(C)
                    If C.Address = firstAddress Then
                        Set C = Nothing
                        firstAddress = vbNullString
                    End If
                Loop While Not C Is Nothing
            Else
                If Onglets(i) = "SuivisAppels" Then _
                    If MsgBox(Onglets(i) & " votre N° " & No & " est absent ! " & vbLf & _
                            "Continuer la recherche ?", _
                            vbQuestion + vbYesNo, Titre) = vbNo Then Exit For
            End If
        End With
    Next
    If i > UBound(Onglets) Then _
    MsgBox "Ben NON : y'a " & IIf(Trouve, "plus", "pas") & "  de " & No & " !", vbCritical, Titre
End If
' Sheets("SuivisAppels").Activate
Application.ScreenUpdating = False
Bloquefeuilles
End Sub