Comment limiter l'action d'une macro

Bonsoir,

J'ai fais un petit programme pour suivre les recettes et les dépenses de notre association. En début de chaque mois, nous avons des dépenses et des recettes récurrentes.

J'essaye d'automatiser ces tâches avec un programme qui crée des entrées automatiquement dans chaque tableau (tableau Dépenses et tableau Revenus) le problème est qu'à chaque fois que j'ouvre le classeur, les entrée se cumulent.

Je ne vois pas comment limiter l'action de la macro à 1 fois par mois.

Voici le code:

Private Sub Workbook_Open()

    'Vérifier si la date est entre le 5 et le 15 de chaque mois
    If Day(Date) >= 5 And Day(Date) <= 15 Then
    
        'Vérifier si le code a déjà été exécuté ce mois-ci
        If Worksheets("Dépenses").Range("A1").Value <> Month(Date) Then
        
            'Mettre à jour la date du mois dernier pour éviter une nouvelle exécution du code ce mois-ci
            Worksheets("Dépenses").Range("A1").Value = Month(Date)
            
            'Trouver la dernière ligne des tableaux Dépenses et Revenus
            Dim lastRowDepenses As Long
            lastRowDepenses = Worksheets("Dépenses").Cells(Rows.Count, "A").End(xlUp).Row
            
            Dim lastRowRevenus As Long
            lastRowRevenus = Worksheets("Revenus").Cells(Rows.Count, "A").End(xlUp).Row
            
            'Ajouter une ligne automatiquement à la fin des tableaux Dépenses et Revenus
            Worksheets("Dépenses").Range("A" & lastRowDepenses + 1).Value = Date
            Worksheets("Dépenses").Range("C" & lastRowDepenses + 1).Value = "aaaaaa"
            Worksheets("Dépenses").Range("D" & lastRowDepenses + 1).Value = "bbbbbb"
            Worksheets("Dépenses").Range("F" & lastRowDepenses + 1).Value = "ccccccc"
            Worksheets("Dépenses").Range("H" & lastRowDepenses + 1).Value = 2
            
            Worksheets("Revenus").Range("A" & lastRowRevenus + 1).Value = Date
            Worksheets("Revenus").Range("C" & lastRowRevenus + 1).Value = "aaaaaa"
            Worksheets("Revenus").Range("D" & lastRowRevenus + 1).Value = "bbbbbbb"
            Worksheets("Revenus").Range("G" & lastRowRevenus + 1).Value = "cccccccc"
            Worksheets("Revenus").Range("I" & lastRowRevenus + 1).Value = 2
            
        End If
        
    End If
    
End Sub

Merci de votre aide,
Windows / Edge 113.0.1774.35