Suppression lignes vides d'un tableau

bonjour,
j'ai créé la macro suivante :

Sub CopierEcheancier()
' CopierEcheancier Macro
Dim Lech As Long

With Sheets("CIC")
ligne = .[a65000].End(xlUp).Row + 1
For Lech = 5 To Sheets("Echéancier").[a65000].End(xlUp).Row
If Sheets("Echéancier").Cells(Lech, 1) = Date Then
Sheets("Echéancier").Cells(Lech, 1).Cut .Cells(ligne, 1)
Sheets("Echéancier").Cells(Lech, 2).Cut .Cells(ligne, 2)
Sheets("Echéancier").Cells(Lech, 3).Cut .Cells(ligne, 3)
Sheets("Echéancier").Cells(Lech, 4).ClearContents
Sheets("Echéancier").Cells(Lech, 5).Cut .Cells(ligne, 6)
Sheets("Echéancier").Cells(Lech, 6).Cut .Cells(ligne, 7)
ligne = ligne + 1
End If
If Sheets("Echéancier").Cells(Lech, 1) < Date Then
Sheets("Echéancier").Cells(Lech, 1).Cut .Cells(ligne, 1)
Sheets("Echéancier").Cells(Lech, 2).Cut .Cells(ligne, 2)
Sheets("Echéancier").Cells(Lech, 3).Cut .Cells(ligne, 3)
Sheets("Echéancier").Cells(Lech, 4).ClearContents
Sheets("Echéancier").Cells(Lech, 5).Cut .Cells(ligne, 6)
Sheets("Echéancier").Cells(Lech, 6).Cut .Cells(ligne, 7)
ligne = ligne + 1
End If
Next
End With

With Sheets("Echéancier")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

.[a65000].End(xlUp).Select
Do
If IsEmpty(ActiveCell) Then
ActiveCell.EntireRow.Delete
End If
ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell.Row = 1

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End With
End Sub


mais elle bug sur la ligne en rouge : la méthode select de la classe range à échoué.

puis je avoir un peu d'aide svp
je cherche à supprimer uniquement les lignes vides du tableau dans la feuille echeancier(car dans ma mise en page j'ai 2 lignes vides avant le tableau).

cordialement