Le dernier code avec for each cellule et else est le plus rapide.
Nickel merci

je suis a 7-8 sec contre 13 avec ton précédent code et 32 avec mon premier

Tu souhaites voir le code complet avec plaisir!
Juste une précision, je bricole des bouts de code comme je peux sans réel connaissance de vba donc si tu as des remarque et amélioration pour mon programme c'est avec plaisir.
Comme tu le remarqueras j'utilise les gestionnaire de nom car je trouve cela plus simple si j'ai à déplacer des cellules.

Avec le dernier teste je trouve que ca fonctionne plutôt bien, il me reste à vérifier que mes feuille s'actualise correctement avant l'impression

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Sub LETSGO1_Click()
Start = Timer
Application.EnableEvents = False            'activation des procédures événementielles
Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationManual
 
Dim wSh1 As Worksheet, wSh2 As Worksheet, wSh3 As Worksheet
Dim kR1 As Long, kR2 As Long, k As Long
Set wSh1 = ActiveWorkbook.Sheets("COM")
Set wSh2 = ActiveWorkbook.Sheets("TOOL")
Set wSh3 = ActiveWorkbook.Sheets("Q")
 
   kR1 = 3      '--- première ligne à traiter
   While wSh1.Cells(kR1, 6) <> ""          '--- continuer tant que cellule en 6eme colonne non vide
      If wSh1.Cells(kR1, 22) = "þ" Then      '--- 22e colonne
         '--- copier de wSh1 sur wSh2
         wSh2.Range("X_1") = wSh1.Cells(kR1, 11)
         wSh2.Range("X_2") = wSh1.Cells(kR1, 12)
         wSh2.Range("X_3") = wSh1.Cells(kR1, 13)
         wSh2.Range("X_4") = wSh1.Cells(kR1, 9)
         wSh2.Range(" X_5") = wSh1.Cells(kR1, 8)
         wSh2.Range("X_F1") = wSh1.Cells(kR1, 14)
         wSh2.Range("X_U1") = wSh1.Cells(kR1, 15)
         wSh2.Range("X_S1") = wSh1.Cells(kR1, 16)
 
         Select Case wSh1.Cells(kR1, 15) & wSh1.Cells(kR1, 16)
            Case "MMQ"
               kR2 = 13
            Case "MMMini/Maxi"
               kR2 = 14
            Case "PMini/Maxi"
               kR2 = 15
            Case Else            '--- autre cas
        MsgBox vbTab & "  Problème syntaxe commande n° " & Cells(kR1, 6).Value & vbTab & Chr(10) & Chr(10) & "Vérifiez que la ligne de la commande correspond à un PMX, NF ou NS Semi-Standard et que sa codification est correct." & Chr(10) & Chr(10) & vbTab & "           !!! La procedure doit être stoppé !!!" & vbTab, , "W.G. MultiCommande Erreur"
        Exit Sub
         End Select
         For k = 1 To 5
            wSh2.Cells(kR2, 1 + 6 * k) = wSh1.Cells(kR1, 16 + k)
         Next k
Call Module1.Hide_ligne3
 
Application.EnableEvents = True            'activation des procédures événementielles
Application.ScreenUpdating = True          'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationAutomatic
 
'wSh2.PrintPreview          '--- aperçu avant impression
'wSh3.PrintPreview          '--- aperçu avant impression
'Call Module1.print pdf
'wSh2.PrintOut              '--- impression directe
'wSh3.PrintOut              '--- impression directe
 
Application.EnableEvents = False            'activation des procédures événementielles
Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationManual
 
      End If
      kR1 = kR1 + 1             '--- passer à la ligne suivante
   Wend
MsgBox "durée du traitement: " & Timer - Start & " secondes"
 
  Start = Timer
    wSh2.Range("X_F1").Value = "TOTO"
    wSh2.Range("X_U1").Value = "U"
    wSh2.Range("X_S1").Value = "SOSO"
    wSh2.Range("Del_codif").Value = ""
    wSh2.Range("Del_cde").Value = ""
Call Module1.Hide_ligne3
 
Worksheets("COM").Activate
Set wSh1 = Nothing
Set wSh2 = Nothing
Set wSh3 = Nothing
 
Application.EnableEvents = True            'activation des procédures événementielles
Application.ScreenUpdating = True          'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationAutomatic
 
MsgBox "durée du traitement: " & Timer - Start & " secondes"
End Sub
 
Sub Hide_ligne3()
'Start = Timer
Application.EnableEvents = False            'activation des procédures événementielles
Application.ScreenUpdating = False          'Désctive le rafraîchissement de l'écran
 
For Each cellule In Range("Hide_FO")
    If cellule.Value = "0" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule
 
Application.EnableEvents = True            'activation des procédures événementielles
Application.ScreenUpdating = True          'Désctive le rafraîchissement de l'écran
'MsgBox "durée du traitement: " & Timer - Start & " secondes"
 End Sub