Aide pour éclaicir un code VBA

Bonjour à toutes et à tous,

Je suis tout nouveau sur ce site et voici ma première question. J'ai mis en place le code suivant qui me permet de copier certaines données d'une feuille de calcul vers une autre feuille du même fichier. Mon code fonctionne bien , au moins jusqu'à maintenant, , mais je le trouve un peu lourd.

lorsque l'utilisateur clique sur le bouton "Valider" alors certaines données de la feuille "Chèques_vacances" sont copiées vers la feuille "Rec_CV". Ensuite la page est éditée en 2 copies.

J'espère être suffisamment clair dans mes explications.

Pourriez-vous m'aider à le rendre un peu plus clair s'il vous plait ?

Je vous en remercie par avance

Cordialement

Private Sub CmbValide_Click()
Application.ScreenUpdating = False
Dim Lig As Long, DerLig As Long
Dim ShtS As Worksheet, ShtF As Worksheet
Set ShtS = Sheets("Chèques_vacances")
Set ShtF = Sheets("Rec_CV")
DerLig = ShtF.Cells(Rows.Count, "A").End(xlUp).Row + 1
For Lig = 2 To DerLig
ShtF.Unprotect "CLAS"
ShtS.Range("F3").Copy
ShtF.Range("A" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("H3").Copy
ShtF.Range("B" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("F15").Copy
ShtF.Range("C" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("F13").Copy
ShtF.Range("D" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("F19").Copy
ShtF.Range("E" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("G19").Copy
ShtF.Range("F" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("H19").Copy
ShtF.Range("G" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("D23").Copy
ShtF.Range("H" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("B23").Copy
ShtF.Range("J" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("B32").Copy
ShtF.Range("K" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("F5").Copy
ShtF.Range("L" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("C36").Copy
ShtF.Range("M" & DerLig).PasteSpecial xlPasteValues
ShtS.Range("F36").Copy
ShtF.Range("N" & DerLig).PasteSpecial xlPasteValues
Next
ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
Application.ScreenUpdating = True
ShtF.Protect "CLAS"
End Sub

Le forum,

Un essai

Private Sub CmbValide_Click()
Dim Lig As Long, DerLig As Long
Dim ShtS As Worksheet, ShtF As Worksheet

Set ShtS = Sheets("Chèques_vacances")
Set ShtF = Sheets("Rec_CV")

Application.ScreenUpdating = False
ShtF.Unprotect "CLAS"

DerLig = ShtF.Cells(Rows.Count, "A").End(xlUp).Row + 1
For Lig = 2 To DerLig
    ShtF.Range("A" & DerLig) = ShtS.Range("F3").Value
    ShtF.Range("B" & DerLig) = ShtS.Range("H3").Value
    ShtF.Range("C" & DerLig) = ShtS.Range("F15").Value
    'etc
Next Lig
ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
ShtF.Protect "CLAS"
Application.ScreenUpdating = True
End Sub

Jim

Bonjour Jim55,

Merci pour ta participation. Je vais essayer ta proposition.

Super ça fonctionne bien et c'est beaucoup plus clair.

Mille mercis