Simplification de code

Bonjour à tous, J'aurais besoin de votre aide pour simplifier se code et le rendre plus rapide :

Ce que je voudrais , c'est que quand je clique sur "valider" , la date de la cellule "J2" se copie sur la feuille "Validité de Tir" que pour les noms dont les cases à cocher sont cochées. Merci de votre aide.

Sub EnregistrementdeTir_Rectangleàcoinsarrondis2_Cliquer()

If Range("J2").Value = "" Then
    MsgBox "Veuillez renseigner une DATE."

Else: Call GUILLEMET
Call NOELLOU
Call DOUAY
Call DRIE
Call IRISSOU
Call LAFONT
Call ARAUX
Call CARNEVILLIER
Call CHARGUI
Call LHUILLERY
Call MADI
Call SALA
Call TASSIN
Call TOUIS
Call MOLIA
Call PERDEREAU
Call TOPA
Call VINCENT
Call DELOR
Call LEBERDER
Call SMAGGHE
Call DECOCHER
Call DECOCHER2
Call DECOCHER3
Call DECOCHER4
Call DECOCHER5
Call DECOCHER6
Call DECOCHER7
Call DECOCHER8
'Call DECOCHER9
Call DECOCHER10
Call DECOCHER11
Call DECOCHER12
Call DECOCHER13
Call DECOCHER14
Call DECOCHER15
Call DECOCHER16
Call DECOCHER17
Call DECOCHER18
Call DECOCHER19
Call DECOCHER20
Call DECOCHER21
Call DECOCHER22
End If
End Sub

Sub GUILLEMET()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'GUILLEMET
    If Range("X11").Value <> VRAI Then
    Range("Y11").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D12").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    If Range("X11").Value <> FAUX Then
    Range("Y11").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub NOELLOU()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'NOELLOU
    If Range("X3").Value <> VRAI Then
    Range("Y3").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D3").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Z3").Select
    Selection.Copy
    Range("X3").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X3").Value <> FAUX Then
    Range("Y3").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub DOUAY()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'DOUAY
    If Range("X4").Value <> VRAI Then
    Range("Y4").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D4").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X4").Value <> FAUX Then
    Range("Y4").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub DRIE()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'DRIE
    If Range("X5").Value <> VRAI Then
    Range("Y5").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D5").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X5").Value <> FAUX Then
    Range("Y5").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub IRISSOU()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   '
    If Range("X6").Value <> VRAI Then
    Range("Y6").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D6").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X6").Value <> FAUX Then
    Range("Y6").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub LAFONT()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   '
    If Range("X7").Value <> VRAI Then
    Range("Y7").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D7").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X7").Value <> FAUX Then
    Range("Y7").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub
Sub ARAUX()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'ARAUX
    If Range("X8").Value <> VRAI Then
    Range("Y8").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D9").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X8").Value <> FAUX Then
    Range("Y8").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub
Sub CARNEVILLIER()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'CARNEVILLIER
    If Range("X9").Value <> VRAI Then
    Range("Y9").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D10").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X9").Value <> FAUX Then
    Range("Y9").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub
Sub CHARGUI()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'CHARGUI
    If Range("X10").Value <> VRAI Then
    Range("Y10").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D11").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X10").Value <> FAUX Then
    Range("Y10").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub
Sub LHUILLERY()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'LUILLERY
    If Range("X12").Value <> VRAI Then
    Range("Y12").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D13").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X12").Value <> FAUX Then
    Range("Y12").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub MADI()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'MADI
    If Range("X13").Value <> VRAI Then
    Range("Y13").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("D14").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X13").Value <> FAUX Then
    Range("Y13").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub
Sub SALA()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'SALA
    If Range("X14").Value <> VRAI Then
    Range("Y14").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I3").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X14").Value <> FAUX Then
    Range("Y14").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub TASSIN()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'TASSIN
    If Range("X15").Value <> VRAI Then
    Range("Y15").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I4").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X15").Value <> FAUX Then
    Range("Y15").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub TOUIS()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'TOUIS
    If Range("X16").Value <> VRAI Then
    Range("Y16").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I5").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X16").Value <> FAUX Then
    Range("Y16").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub MOLIA()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'MOLIA
    If Range("X17").Value <> VRAI Then
    Range("Y17").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I7").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X17").Value <> FAUX Then
    Range("Y17").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub PERDEREAU()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'PERDEREAU
    If Range("X18").Value <> VRAI Then
    Range("Y18").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I8").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X18").Value <> FAUX Then
    Range("Y18").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub TOPA()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'TOPA
    If Range("X19").Value <> VRAI Then
    Range("Y19").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I9").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X19").Value <> FAUX Then
    Range("Y19").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub VINCENT()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'VINCENT
    If Range("X20").Value <> VRAI Then
    Range("Y20").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I10").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X20").Value <> FAUX Then
    Range("Y20").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub DELOR()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'DELOR
    If Range("X21").Value <> VRAI Then
    Range("Y21").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I12").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X21").Value <> FAUX Then
    Range("Y21").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub LEBERDER()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'LEBERDER
    If Range("X22").Value <> VRAI Then
    Range("Y22").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I13").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X22").Value <> FAUX Then
    Range("Y22").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

Sub SMAGGHE()
Application.ScreenUpdating = False

    Sheets("Enregistrement de Tir").Select

   'SMAGGHE
    If Range("X23").Value <> VRAI Then
    Range("Y23").Select
    Selection.Copy
    Sheets("Validité de Tir").Select
    Range("I14").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

    If Range("X23").Value <> FAUX Then
    Range("Y23").Select
    Selection.Copy
    Sheets("POUBELLE").Select
    Range("A1").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If

    ActiveWorkbook.Save
    Sheets("Enregistrement de Tir").Select

    End Sub

    Sub DECOCHER()
    If Range("X3").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X3").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER2()
    If Range("X4").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X4").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER3()
    If Range("X5").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X5").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER4()
    If Range("X6").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X6").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER5()
    If Range("X7").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X7").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER6()
    If Range("X8").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X8").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER7()
    If Range("X9").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X9").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER8()
    If Range("X10").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X10").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER10()
    If Range("X11").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X11").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER11()
    If Range("X12").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X12").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER12()
    If Range("X13").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X13").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER13()
    If Range("X14").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X14").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER14()
    If Range("X15").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X15").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER15()
    If Range("X16").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X16").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER16()
    If Range("X17").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X17").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER17()
    If Range("X18").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X18").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER18()
    If Range("X19").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X19").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER19()
    If Range("X20").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X20").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER20()
    If Range("X21").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X21").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER21()
    If Range("X22").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X22").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
    End Sub

    Sub DECOCHER22()
    If Range("X23").Value <> VRAI Then
    Range("Z3").Select
    Selection.Copy
    Range("X23").Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If

End Sub

Bonjour

Sans fichier c'est moins facile..

Une première approche en modifiant le code Guillemet

Sub GUILLEMET()
'GUILLEMET
Application.ScreenUpdating = False
With Sheets("Enregistrement de Tir")
    If .Range("X11").Value <> VRAI Then
        .Range("Y11").Copy
        Sheets("Validité de Tir").Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If

    If .Range("X11").Value <> FAUX Then
        Range("Y11").Copy
        Sheets("POUBELLE").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
End With
ActiveWorkbook.Save
End Sub

Modifie ensuite tous les codes en dessous pour qu'ils aient la même structure

Cordialement

https://www.cjoint.com/c/EJDlmUk7uKG

Re,

En cas de FAUX en colonne X pourquoi copie-t-on toujours en cellule A1 de la feuille POUBELLE

La colonne Y dans la feuille Enregistrement ne sert à rien puisque c'est J2 que l'on doit copier. Exact ?

Savoir aussi le pourquoi des codes Decocher ?

Crdlt

Re,

C'est juste pour me débarrasser de la valeur si FAUX

Oui la colonne Y ne sert à rien, c'était juste pour un essai

Le code DECOCHER c'est pour décocher toutes les cases à cocher

Merci de ton aide

Re,

Beau fichier ...

Essaie avec ces deux codes uniquement :

Option Compare Text
Sub EnregistrementdeTir_Rectangleˆcoinsarrondis2_Cliquer()
With Sheets("Enregistrement de Tir")
    If .Range("J2").Value = "" Then
        MsgBox "Veuillez renseigner une DATE en cellule " & .Range("J2")

    Else: Call Valider
    End If
End With
ActiveWorkbook.Save
End Sub

Sub Valider()

Dim cel As Range
Dim lg As Byte, cl As Byte
Application.ScreenUpdating = False
With Sheets("Enregistrement de Tir")

    For Each cel In .Range("X3:X23")
        If cel.Value = "VRAI" Then
            On Error Resume Next
            lg = Sheets("Validité de Tir").Cells.Find(cel.Offset(0, -1), LookIn:=xlValues, LookAt:=xlWhole).Row
            cl = Sheets("Validité de Tir").Cells.Find(cel.Offset(0, -1), LookIn:=xlValues, LookAt:=xlWhole).Column
            If lg > 0 Then
                .Range("J2").Copy Sheets("Validité de Tir").Cells(lg, cl + 1)
                cel.Value = "FAUX"
            End If
            On Error GoTo 0
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

Attention à bien mettre l'instruction "Option Compare Text" en entête du module avant toute macro

Juste un conseil, évite les accents et les espaces dans le nom des feuilles. Cela ne cause que des soucis en VB``

Cordialement

https://www.cjoint.com/c/EJDnH5AfY3G

Merci Dan ça fonctionne à part 1 petits problèmes :

1. J'aurais voulus que les cases se remettent en mode "décocher" aprés validation.

C' est bon, solution trouvé.

J'ai donné la valeur "FAUX" à la cellule "Z3"

Et j'ai remplacé

cel.Value = "FAUX" par cel.Value = Range("Z3").Value

Un grand merci à toi pour ton aide et ta patience.