recopiage et classement par mois

Sub Recap()

Dim DerLig1 As Integer, DerLig2 As Integer, i As Integer, Réf_VaR As Long, k As Integer, l As Integer
Dim Colonne_O As String, Colonne_P As String, Colonne_Q As String, Colonne_R As String, Chemin As String, Nom_de_ce_fichier As String

Application.ScreenUpdating = False

Nom_de_ce_fichier = ThisWorkbook.Name
Chemin = ThisWorkbook.Path

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
For j = 1 To 52
Workbooks.Open Filename:=Chemin & "\EM 141 - S " & Right("0" & CStr(j), 2) & ".xls"
Windows("EM 141 - S " & Right("0" & CStr(j), 2) & ".xls").Activate
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

DerLig1 = Range("C" & Rows.Count).End(xlUp).Row

'copie des dossiers sur le fichier de dossiers annuels
For i = 3 To DerLig1
    Range("A" & i & ":Y" & i).Copy
    Windows(Nom_de_ce_fichier).Activate
    DerLig2 = Range("C" & Rows.Count).End(xlUp).Row
    Range("A" & DerLig2 + 1).PasteSpecial

Next

'tri fichier dossiers annuels
Windows(Nom_de_ce_fichier).Activate
DerLig2 = Range("C" & Rows.Count).End(xlUp).Row
Rows("2:" & DerLig2).Select
Selection.Sort Key1:=Range("C3"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
          
'suppression des doublons du fichier dossiers annuels pour qu'ils n'apparaissent qu'une fois
Cells(4, 3).Activate
Do Until ActiveCell = ""
    If ActiveCell = ActiveCell.Offset(-1, 0) Then
        ActiveCell.Offset(-1, 0).EntireRow.Delete
        ActiveCell.Activate
    End If
    ActiveCell.Offset(1, 0).Activate
Loop

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Windows("EM 141 - S " & Right("0" & CStr(j), 2) & ".xls").Close
Next j
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

End Sub