Optimisation de code

bonjour le Forum,

J'ai écrit un code qui, je pense peut être optimisé avec une boucle. Malheureusement je ne maîtrise pas du tout.

Voici le code:

Sub BntM12_3_Click()

    If BntM12_3 = True Then
    MsgBox "Il n'existe pas de vis Dural M12.3 ! le KIT 1B va être supprimé", 16, "le KIT 1B ne peut pas être appliqué..."
    End If
  Unload Me
Application.ScreenUpdating = False
  If Worksheets("Enquête").Range("F71") = "Estimation" And [K92] = True Then
  Worksheets("Enquête").[K92] = False
End If
  If Worksheets("Enquête").Range("F105") = "Estimation" And [K126] = True Then
  Worksheets("Enquête").[K126] = False
End If
  If Worksheets("Enquête").Range("F139") = "Estimation" And [K160] = True Then
  Worksheets("Enquête").[K160] = False
End If
  If Worksheets("Enquête").Range("F173") = "Estimation" And [K194] = True Then
  Worksheets("Enquête").[K194] = False
End If
  If Worksheets("Enquête").Range("F207") = "Estimation" And [K228] = True Then
  Worksheets("Enquête").[K228] = False
End If
  If Worksheets("Enquête").Range("F241") = "Estimation" And [K262] = True Then
  Worksheets("Enquête").[K262] = False
End If
  If Worksheets("Enquête").Range("F275") = "Estimation" And [K296] = True Then
  Worksheets("Enquête").[K296] = False
End If
  If Worksheets("Enquête").Range("F309") = "Estimation" And [K330] = True Then
  Worksheets("Enquête").[K330] = False
End If
  If Worksheets("Enquête").Range("F343") = "Estimation" And [K364] = True Then
  Worksheets("Enquête").[K364] = False
End If
  If Worksheets("Enquête").Range("F377") = "Estimation" And [K398] = True Then
  Worksheets("Enquête").[K398] = False
End If
  If Worksheets("Enquête").Range("F411") = "Estimation" And [K432] = True Then
  Worksheets("Enquête").[K432] = False
End If
  If Worksheets("Enquête").Range("F445") = "Estimation" And [K466] = True Then
  Worksheets("Enquête").[K466] = False
End If
  If Worksheets("Enquête").Range("F479") = "Estimation" And [K500] = True Then
  Worksheets("Enquête").[K500] = False
End If
  If Worksheets("Enquête").Range("F513") = "Estimation" And [K534] = True Then
  Worksheets("Enquête").[K534] = False
End If
  If Worksheets("Enquête").Range("F547") = "Estimation" And [K568] = True Then
  Worksheets("Enquête").[K568] = False
End If
  ThisWorkbook.Sheets("calcul").Unprotect Password:=""
  Feuil2.Cells(33, 4).ClearContents
  Feuil2.Range("A33").Interior.Color = xlNone

  ThisWorkbook.Sheets("calcul").Protect Password:=""
  Application.ScreenUpdating = True
End Sub

Merci d'avance pour votre aide

Hello,

Pour remplacer les if

Pas testé :

Const Name_F As String = "Enquête"
Const sEsti As String = "Estimation"

Dim Cpt_Col_F As Byte, Cpt_Col_K As Byte, Nb_Test As Byte
Dim i As Long, Debut_Test As Long

Cpt_Col_F = 34
Cpt_Col_K = 21
Nb_Test = 10

With Sheets(Name_F)
    Debut_Test = 71
    For i = 1 To Nb_Test
        If .Range("F" & Debut_Test).Value = sEsti _
            And .Range("K" & (Debut_Test + Cpt_Col_K)) = True Then .Range("K" & (Debut_Test + Cpt_Col_K)) = False
        Debut_Test = Debut_Test + Cpt_Col_F
    Next i
End With

Bonsoir,

une autre proposition avec un OffSet croissant de i x 34 :

With Sheets("Enquête")
    For i = 0 To 9
        If .Range("F71").Offset(i * 34).Value = "Estimation" And .Range("K92").Offset(i * 34) = True Then .Range("K92").Offset(i * 34).Value = False
    Next i
End With

@ bientôt

LouReeD

Un grand merci à vous deux.

Les 2 solutions fonctionnent très bien