Sub cherche()
Dim X As Long
Application.ScreenUpdating = False
X = 1
Do
If Range("A" & X) <> Range("A" & X).Row And Range("A" & X) <> "" Then
Rows(X).Insert
End If
X = X + 1
Loop Until X = Cells(Rows.Count, "A").End(xlUp).Row + 1
Application.ScreenUpdating = True
End Sub