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

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite une belle journée

Je reviens vers nos ténors car j'ai un grave souci
Notre fichier de travail à toujours eu quelques ralentissement quand nous lançons un inputbox.
Mais depuis quelques temps, ça devient catastrophique.
Notamment au lancement de l'inputbox de recherche.
C'est devenu quasiment permanent ... 10 à 15 minutes d'attente à chaque lancement et ça toute la journée. Cela nous bloque dans notre travail.

A force de recherches, j'ai pensé qu'il s'agissait d'un souci de mémoire.
Selon mes lectures internet, pensant que la mémoire pourrait être libérée au fur et à mesure, j'ai ajouté à la fin des instructions Set ... :"Set ... = Nothing"
Malheureusement sans succès.

En fait, il semblerait que ce soit l'utilisation du Processeur qui soit en cause car
il passe pendant les blocages à plus de 47% d'utilisation alors que normalement il ne dépasse pas les 5%.

Je joins les éléments suivants :
- l'image info disque qui montre un espace libre de 327 Go,
- l'image info du système,
- l'image de l'état du processeur aux moments des bugs de ralentissement,
- le code de l'UserForm de recherche,

Sub Recherche_youky()
nom = InputBox("Cherche N° Client :" & Chr(10) & "      - Si pas de n°," & Chr(10) & "            - ou erreur n°," & Chr(10) & "                  Recommencez !", "Recherche")
If nom = "" Then
[a6].Select
Sheets("format-numero").Visible = False
Exit Sub
End If
Sheets("format-numero").Range("h3") = ""
  q = ActiveSheet.Index
  For q = q To ActiveSheet.Index + Sheets.Count - 1
    K = (q - 1) Mod (Sheets.Count) + 1
With Sheets(K).UsedRange
Application.ScreenUpdating = False
Range([g2], Cells(Rows.Count, "h").End(xlUp)).Activate
Set C = .Find(nom, LookAt:=xlPart)   'LookAt:=xlpart dans cellule - LookAt:=xlWhole) 'cellule entière
[a1].Activate
If Not C Is Nothing Then
firstAddress = C.Address
Do
On Error Resume Next
Sheets(K).Select
C.Activate
    Application.ScreenUpdating = True
    ActiveWindow.ScrollRow = Selection.Row
    If ActiveSheet.Name = "CopieAppels" Then
    Selection.RowHeight = 50
    End If

    If ActiveSheet.Name = "SuivisAppels" Then
    If Cells(ActiveCell.Row, 7) = C Or Cells(ActiveCell.Row, 8) = C Then

    Rows("6:6").Copy
    Cells(ActiveCell.Row, 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.RowHeight = 300

    End If
    End If
    Cells(ActiveCell.Row, 1).Select

If ActiveSheet.Name = "SuivisAppels" And Cells(ActiveCell.Row, 7) <> C And Cells(ActiveCell.Row, 8) <> C Then
rep = MsgBox(ActiveSheet.Name & " votre N° : " & C & " est absent ! Continuer la recherche ?", 4 + 32, "Sélection")
Sheets("format-numero").Visible = False
Else
rep = MsgBox(C & " : OK dans " & ActiveSheet.Name & Chr(10) & "" & Chr(10) & "Cellule - ligne :  " & C.Address & Chr(10) & Chr(10) & "" & "Continuer la recherche ?", 4 + 32, "Résultat")
End If
If rep = vbNo Then
Application.ScreenUpdating = False
Sheets("format-numero").Visible = False
Exit Sub
End If
Application.ScreenUpdating = False
Sheets("format-numero").Range [h3] = ""
Sheets("format-numero").Visible = False
If ActiveSheet.Name = "CopisAppels" Then
Sheets("SuivisAppels").Select
End If
Application.ScreenUpdating = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
  Next q
MsgBox "Ben NON : y'a pas ou y'a plus !"
Application.ScreenUpdating = False
Sheets("format-numero").Visible = False
End Sub

Profane complet en la matière, je ne sais plus quoi faire.
Auriez-vous des idées, solutions ou pistes vers où me diriger ?

Avec mes remerciements,
Amicalement,
lionel,

 

[soan]

@Lionel

ça y'est, j'ai retrouvé le film qui te conviendrait le mieux, dans le rôle de
J. L. (alias D. J. & M. L.) : et mes amitiés à la super-jolie Stella !

soan