Supression ligne suivant 2 critères contenus dans cellules - amélioration code vitesse

Sub EffacerlignesPériode()
Worksheets("ExportEcritures").Select
derniereligne = Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
ReDim tabli(0)
For I = derniereligne To 1 Step -1
If Cells(I, 1) <> "" And Cells(I, 1) < Range("Départ!e8").Value Or Cells(I, 1) > Range("Départ!e9").Value Then
tabli(UBound(tabli)) = I
ReDim Preserve tabli(UBound(tabli) + 1)
End If
Next
Application.ScreenUpdating = False
For n = 0 To UBound(tabli) - 1
  Rows(tabli(n)).Delete
Next
Application.ScreenUpdating = True
End Sub

Sub EffacerlignesPériode()
   Dim derlig&, premcolvide&, t, i, min, max, ti
   ti = Timer: Application.ScreenUpdating = False
   min = Range("Départ!e8"): max = Range("Départ!e9")
   With Worksheets("ExportEcritures")
      derlig = .Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
      premcolvide = .UsedRange.Column + .UsedRange.Columns.Count
      t = .Range("a1:a" & derlig)
      For i = 1 To derlig
         t(i, 1) = IIf(t(i, 1) <> "" And (t(i, 1) < min Or t(i, 1) > max), CVErr(xlErrDiv0), Empty)
      Next i
      .Cells(1, premcolvide).Resize(derlig) = t
      .Range(.Cells(1, "a"), .Cells(derlig, premcolvide)).Sort key1:=.Cells(1, premcolvide)
      On Error Resume Next
      .Cells(1, premcolvide).Resize(derlig).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
   End With
   MsgBox Format(Timer - ti, "0.00\ sec.")
End Sub

Sub Export_ecritures_Octopus_formatage_CSV()
chemin = Range("Départ!f2").Value
MonFichier = Range("Départ!e3").Value
'chemin = ThisWorkbook.Path
'MonFichier = "Test.csv"
MonSep = ","
'--------------------------------
Worksheets("ExportEcritures").Select
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile chemin & "\" & MonFichier
Set f = fs.GetFile(chemin & "\" & MonFichier)
Set ts = f.OpenAsTextStream(2, -2)
For Each X In ActiveSheet.Range("A1:" & ActiveSheet.Range("A65536").End(xlUp).Address)
    For Each Y In ActiveSheet.Range(X, ActiveSheet.Cells(X.Row, 256).End(xlToLeft))
        MaVar = MaVar & MonSep & """" & Y & """"
    Next
ts.Write Right(MaVar, Len(MaVar) - 1) & Chr(13) + Chr(10)
MaVar = ""
Next
ts.Close
End Sub

.Cells(1, premcolvide).clear

End With

Sub EffacerlignesPériode()
   Dim derLig&, premColVide&, t, i, min, max, valErreur, ti
   ti = Timer: Application.ScreenUpdating = False
   ' on stocke les deux bornes dans des variables et une variable contenant une erreur
   min = Range("Départ!e8"): max = Range("Départ!e9"): valErreur = CVErr(xlErrDiv0)
   With Worksheets("ExportEcritures")  'avec la feuille "ExportEcritures"
      'dernière ligne de la colonne A
      derLig = .Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
      ' Première colonne non utilisée de la feuille
      ' UsedRange contient la plage utilisée de la feuille
      ' on considère la première colonne de cette zone (qui n'est pas toujours la colonne A)
      ' on y rajoute le nombre de colonne de cette zone pour obtenir la première colonne non utilisée
      premColVide = .UsedRange.Column + .UsedRange.Columns.Count
      ' transfert des valeurs de la colonne A dans un tableau t
      t = .Range("a1:a" & derLig)
      'pour chaque valeur du tableau t
      ' si elle répond aux conditions de suppression, on la remplace par une valeur d'erreur
      ' si elle ne répond pas aux conditions de suppression, on la remplace par vide
      For i = 1 To derLig
         t(i, 1) = IIf(t(i, 1) <> "" And (t(i, 1) < min Or t(i, 1) > max), valErreur, Empty)
      Next i
      ' on transfère les nouvelles valeurs du tableau t sur la feuille, dans la première
      ' colonne inutilisée
      .Cells(1, premColVide).Resize(derLig) = t
      ' on trie la feuille selon la dernière colonne (vide ou valeur d'erreur)
      .Range(.Cells(1, "a"), .Cells(derLig, premColVide)).Sort key1:=.Cells(1, premColVide)
      On Error Resume Next 'au cas où aucune ligne ne répondrait aux critères
      ' on demande de considérer les cellules de la dernière colonne ayant une valeur d'erreur
      ' (ces cellules sont contigües à cause du tri qu'on a fait) et on supprime les lignes
      ' entières de ce bloc de cellules
      .Cells(1, premColVide).Resize(derLig).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
      ' on efface la dernière colonne utilisée
      .Cells(1, premColVide).EntireColumn.Clear
   End With
   MsgBox Format(Timer - ti, "0.00\ sec.")
End Sub

.Cells(1, premcolvide).clear

D01    170001    201701    2017/01/31               
D01    170001    1    S        94    A-170001-BORESLAUSCHI MIHAELA 8    241
D01    170001    2    A    610302        A-170001-BORESLAUSCHI MIHAELA 8    -227,36
D01    170001    3    A    498100        A-170001-BORESLAUSCHI MIHAELA 8    -13,64
D01    170002    201701    2017/01/26               
D01    170002    1    S        68    A-170002-MARTENS CONFECTIE 2503857    2811
D01    170002    2    A    604000        A-170002-MARTENS CONFECTIE 2503857    -2811
D01    170002    3    A    498100        A-170002-MARTENS CONFECTIE 2503857    -590,31
D01    170002    4    A    498015        A-170002-MARTENS CONFECTIE 2503857    590,31

Sub EffacerlignesPériode_b()
   Dim derLig&, premColVide&, t, i, min, max, valErreur, ti
   ti = Timer: Application.ScreenUpdating = False
   ' on stocke les deux bornes dans des variables et une variable contenant une erreur
   min = Range("Départ!e8"): max = Range("Départ!e9"): valErreur = CVErr(xlErrDiv0)
   With Worksheets("ExportEcritures")  'avec la feuille "ExportEcritures"
      'dernière ligne de la colonne A
      derLig = .Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
     'on insere une colonne avant la colonne A
      .Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
      ' transfert des valeurs de la colonne A dans un tableau t
      t = .Range("B1:B" & derLig)
      'pour chaque valeur du tableau t
      ' si elle répond aux conditions de suppression, on la remplace par une valeur d'erreur
      ' si elle ne répond pas aux conditions de suppression, on la remplace par vide
      For i = 1 To derLig
         t(i, 1) = IIf(t(i, 1) <> "" And (t(i, 1) < min Or t(i, 1) > max), valErreur, Empty)
      Next i
      ' on transfère les nouvelles valeurs du tableau t sur la feuille, dans la première
      ' colonne
      .Cells(1, 1).Resize(derLig) = t
      ' on trie la feuille selon la  colonne A (vide ou valeur d'erreur)
      .Range(.Cells(1, "a"), .Cells(derLig, Columns.Count)).Sort key1:=.Cells(1, 1)
      On Error Resume Next 'au cas où aucune ligne ne répondrait aux critères
      ' on demande de considérer les cellules de la dernière colonne ayant une valeur d'erreur
      ' (ces cellules sont contigües à cause du tri qu'on a fait) et on supprime les lignes
      ' entières de ce bloc de cellules
      .Cells(1, 1).Resize(derLig).SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
      ' on efface la dernière colonne utilisée
      .Cells(1, 1).EntireColumn.Delete
   End With
   MsgBox Format(Timer - ti, "0.00\ sec.")
End Sub