Macro copier donées selon condition

Bonjour,

J'ai une macro qui me permets de copier les données d'une plage de cellules vers un autre fichier.

La macro copie ne copie les données qu'une fois, sinon il y a un message. Je souhaiterai inclure dans le code de la macro, que si on est le le 1er jour de la semaine, donc lundi, elle me copie 3 fois ces données.

Par avance, merci.

Dim WsS As Worksheet, WsC As Worksheet
Dim DerDte As Date
    On Error GoTo ouvrirDoc
    Set WsS = ThisWorkbook.Worksheets("Tréso") 'Feuille source
   Set WsC = Workbooks("REPORTING TRESORERIE.xlsx").Sheets("Tréso") 'Feuille cible
   Application.ScreenUpdating = False
    DerDte = WsC.Cells(Rows.Count, "A").End(xlUp).Value
    If DerDte = WsS.Cells(2, "A").Value Then
        MsgBox "Les données du " & DerDte & " ont déjà été reportées !", 16
        End
    Else
        WsS.Range("A2:M" & WsS.Range("A" & Rows.Count).End(xlUp).Row).Copy
        WsC.Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
    End If
    Application.CutCopyMode = xlCopy
    MsgBox "Mise à jour effectuée avec succès !"
    Set WsC = Nothing: Set WsS = Nothing
    Exit Sub
ouvrirDoc:
    MsgBox "Ouvrez le fichier ''REPORTING TRESORERIE ''", 16
End Sub

Bonjour

Sans fichier pour tester

Modifies ta macro

Sub test()
Dim WsS As Worksheet, WsC As Worksheet
Dim DerDte As Date
Dim I As Integer, JourSem As Integer, NbFois As Integer

  On Error GoTo ouvrirDoc
  JourSem = Weekday(Date, vbMonday)
  Set WsS = ThisWorkbook.Worksheets("Tréso")  'Feuille source
  Set WsC = Workbooks("REPORTING TRESORERIE.xlsx").Sheets("Tréso")  'Feuille cible
  Application.ScreenUpdating = False
  DerDte = WsC.Cells(Rows.Count, "A").End(xlUp).Value
  If JourSem <> 1 And DerDte = WsS.Cells(2, "A").Value Then
    MsgBox "Les données du " & DerDte & " ont déjà été reportées !", 16
    End
  Else
    If JourSem = 1 Then NbFois = 3 Else NbFois = 1
   For I = 1 To NbFois
      WsS.Range("A2:M" & WsS.Range("A" & Rows.Count).End(xlUp).Row).Copy
      WsC.Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
    Next I
  End If
  Application.CutCopyMode = xlCopy
  MsgBox "Mise à jour effectuée avec succès !"
  Set WsC = Nothing: Set WsS = Nothing
  Exit Sub
ouvrirDoc:
  MsgBox "Ouvrez le fichier ''REPORTING TRESORERIE ''", 16
End Sub

Merci, je vais tester.