Optimisation d'un code

Bonjour à tous,

J'ai réalisé ce bout de code afin de vérifier si ente deux date, si dans la colonne "F" la valeur est égale à "Oui" (Je souhaite savoir si la ligne est prélèvement automatique). Si oui alors je récupère les données de la ligne de la colonne "C" à "I" et les intègre à la dernière ligne. En "B" j'inscris la date avec un mois supplémentaire et en "J" j'intègre une liste de validation. Après je passe à la ligne suivante et ainsi de suite jusqu'à la fin de ma boucle.

Ce code fonctionne parfaitement bien mais le calcul dure plus de 20 secondes. Mes compétences en VBA sont vraiment très limitées. Cf le code plus bas. Alors, je viens vous demander si il y a moyen d'optimiser l'écriture de mon code afin que le calcul soit plus rapide.

Encore un fois je vous remercie par avance et à très bientôt.

Cdt, Ludwig

Sub PrélèvementAuto()

Colonne = 2
Boucle = 9
BoucleFin = Worksheets("Journal").Cells(65536, Colonne).End(xlUp).Row
Fin = 8


While Boucle <= BoucleFin 'Je boucle sur toutes les lignes de mon tableau
    
'Je redonne les valeurs de départ
Colonne = 2
BoucleFin = Worksheets("Journal").Cells(65536, Colonne).End(xlUp).Row
Début = 2

'Je vérifie si les dates sont comprises entre le début du mois et la fin du mois précédent
If Worksheets("Journal").Cells(Boucle, Colonne).Value >= Worksheets("Paramètres").Range("DateDébutPlvtAuto").Value And Worksheets("Journal").Cells(Boucle, Colonne).Value <= Worksheets("Paramètres").Range("DateFinPlvtAuto").Value Then
    
    'Je vérifie si la colonne 6 est égale à "Oui"
    If Worksheets("Journal").Cells(Boucle, Colonne + 4).Value = "Oui" Then 'Si oui
        
        'J'inscris la date avec un mois de plus à la dernière ligne
        Worksheets("Journal").Cells(BoucleFin + 1, Colonne).Value = DateAdd("m", 1, Worksheets("Journal").Cells(Boucle, Colonne).Value)

            With Worksheets("Journal")  ' Ajout d'un liste déroulante "Oui" à la colonne "Vérif"
                Set Plage = .Cells(BoucleFin + 1, Colonne + 8)
            End With
   
            With Plage.Validation
                .Delete
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=OuiListe"
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
        End With
        
        'je fais une boucle afin de récupérer les valeurs de la ligne sur chaque colonne
        While Début <= Fin
            Worksheets("Journal").Cells(BoucleFin + 1, Colonne + 1).Value = Worksheets("Journal").Cells(Boucle, Colonne + 1).Value
            Colonne = Colonne + 1
            Début = Début + 1
        Wend
                
    End If

End If

    Boucle = Boucle + 1
    
Wend

Cells(Cells(65536, Colonne).End(xlUp).Row, Colonne).Select

End Sub