Optimisation programme - Union de zones à supprimer

Bonjour,

J'ai besoin d'aide pour optimiser une boucle qui me permet de supprimer des cellules 1 ligne sur 2, voici le code :

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Rows("1:1").Delete Shift:=xlUp
Rows("1:1").Delete Shift:=xlUp
Set Zone = Range(Cells(2, 1), Cells(2, 2))
For a = 4 To 104830 Step 2
    Set Zone = Union(Zone, Range(Cells(a, 1), Cells(a, 2)))
Next a

Zone.Delete Shift:=xlUp

J'ai essayé en supprimant les lignes plutôt que les 2 cellules concernées et ce n'est pas plus rapide, même chose en supprimant au fur et à mesure les cellules/lignes plutôt qu'une zone globale à supprimer en une seule fois.

Actuellement mon pc met environ 30 min à faire cette boucle et c'est bien trop lent pour le nombre de fichiers pour lesquels je vais devoir faire cette boucle.

Quelqu'un aurait-il une idée pour faire la même chose plus rapidement ? "a" est déclaré comme "Long" et "Zone" comme "Range".

Merci par avance,