[XL-2007] Macro pour dupliquer des données

Bonjour au forum,

J'ai une macro pour dupliquer les données du fichier "Import CA" vers le fichier "Suivi_CA".
La macro doit me dupliquer les données de Vendredi aux dates de Samedi et Dimanche si le dernier jour du fichier "Import_Ca" est un Jeudi.

Mais cependant je rencontre un léger problème. Je n'arrive pas à dupliquer parfaitement les données de vendredi qui représentent 161 lignes sur le samedi et dimanche. La macro ne me duplique qu’ 1 ligne sur les 161
Qu'est-ce qui ne va pas ?

Je vous remercie d'avance de votre aide.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub MiseAjour2()
 
Dim WsS As Worksheet, WsC As Worksheet
Dim JourJ As Integer, DerJour As Integer
Dim DerLig As Long
Dim i As Byte
    Set WsS = ThisWorkbook.Worksheets("Tréso") 'Classeur Source
  Set WsC = Workbooks("Suivi_CA.xlsx").Worksheets("Tréso") 'Classeur Cible
 
   'On dédertmine la date du jour indiqué en A2
  JourJ = Weekday(WsS.Range("A2"), 2)
 
   'On détermine le dernier jour indiqué en colonne A
   DerJour = Weekday(WsC.Range("A" & WsC.Rows.Count).End(xlUp), 2)
 
   'On effectue la copie de A2 à L162
   WsC.Range("A" & WsC.Rows.Count).End(xlUp).Offset(1).Resize(161, 12).Value = WsS.Range("A2:L162").Value
 
    ''Si on est dans le cas où le jour en A2 est un vendredi
      'et le dernier jour indiqué en colonne A (avant copie) est un jeudi
   If JourJ = 5 And DerJour = 4 Then
        For i = 1 To 2
            DerLig = WsC.Range("A" & Rows.Count).End(xlUp).Row
            WsC.Range("A" & DerLig + 1).Value = WsC.Range("A" & DerLig).Value + 1
            WsC.Range("L" & DerLig + 1).Value = WsC.Range("L" & DerLig).Value
        Next i
    End If
    Application.CutCopyMode = False
End Sub