XL 2013 Simplification de code

derligne = F.Sheets(1).Range("A" & rows.count).End(xlUp).Row

Sub Compilation_1()

Dim ProdSchedule As Worksheet, shRecap As Worksheet
Dim FichierR$, CheminR$
Dim Wb As Workbook

Set ProdSchedule = ThisWorkbook.Worksheets("Production_Schedule")
Set shRecap = ThisWorkbook.Worksheets("RECAP")
Set Wb = ThisWorkbook
CheminR = Wb.Path & "\Production Schedules reçus\"
FichierR = Dir(CheminR & "*.xls*")

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

With ProdSchedule
    If .FilterMode Then
    .ShowAllData
    End If
    Columns("A:AM").EntireColumn.Hidden = False
End With


'Consolider les production schedules
shRecap.Visible = True

Do While FichierR <> ""

    Set F = Workbooks.Open(CheminR & FichierR)
    derligne = F.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


    With F.Worksheets(1)
        If .FilterMode Then .ShowAllData
        Sheets("Feuil1").Columns("A:AM").EntireColumn.Hidden = False
    End With
  
    F.Sheets(1).Range("A2:AI" & derligne).Copy shRecap.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    F.Close SaveChanges:=False
  
    FichierR = Dir

Loop

'Supprimer les lignes des production schedules importés

Dim cel As Range, derlig&, derL&, i&

    Application.ScreenUpdating = False
    derlig = Sheets("Production_Schedule").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Production_Schedule")
        derL = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = derL To 2 Step -1
            Set cel = shRecap.Range("c2:c" & derlig).Find(.Range("c" & i).Value, lookat:=xlWhole)
            If Not cel Is Nothing Then
                .Rows(i).Delete
                Set cel = Nothing
            End If
        Next i
    End With

shRecap.Activate

'Ne pas afficher les cellules vides
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:="<>"


'Selectionner toutes les cellules pleines et indiquer la date
shRecap.Activate
    Range("AI2").FormulaR1C1 = "=""Importé le ""&TEXT(now(),""jj-mmm-aa hh:mm"" )"
   [AI2:AI2].AutoFill Range("AI2:AI" & Cells(Rows.Count, 1).End(xlUp).Row)


derL_MAJ = shRecap.Cells(Rows.Count, 1).End(xlUp).Row
derL_TB = 1 + Sheets("Production_Schedule").Cells(Rows.Count, 1).End(xlUp).Row

shRecap.Range("a2:AI" & derL_MAJ).Copy

Sheets("Production_Schedule").Activate

Range("A" & derL_TB).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

'vider RECAP
With Sheets("RECAP")
.Range("a2:am" & derligne).ClearContents
.Visible = False
End With

'*****************

Sheets("Production_Schedule").Activate

'supprimer les fichiers reçus
Kill CheminR & "*.*"


MsgBox "Les Production Schedules ont été importés !"

End Sub

'Supprimer les lignes des production schedules importés

Dim cel As Range, derlig&, derL&, i&

    Application.ScreenUpdating = False
    derlig = Sheets("Production_Schedule").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Production_Schedule")
        derL = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = derL To 2 Step -1
            Set cel = shRecap.Range("c2:c" & derlig).Find(.Range("c" & i).Value, lookat:=xlWhole)
            If Not cel Is Nothing Then
                .Rows(i).Delete
                Set cel = Nothing
            End If
        Next i
    End With

Sub ListeSansDoublons()
  Set mondico = CreateObject("Scripting.Dictionary")
  a = Sheets("RECAP").Range("C2:C" & [C65000].End(xlUp).Row)   ' tableau a(n,1)
  For i = LBound(a) To UBound(a)
    mondico(a(i, 1)) = ""
  Next i
  Sheets("RECAP").[AN1].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
End Sub