Macro: supprimer x ligne sur y

Option Explicit
Option Base 1
Sub Supprimer_svt_pas()
Dim Pas As Byte
Dim Ligfin As Long, T_in(), T_out(), Idx As Long, Cptr As Long, Col As Byte
Dim start As Single

ReDim T_out(3, 1)

Application.ScreenUpdating = False
On Error GoTo Erreur
Pas = Application.InputBox("saisir le Pas de suppression désiré", 1)
On Error GoTo 0
start = Timer

'mémorisation tableaux en RAM
Ligfin = Columns("A").Find("*", , , , , xlPrevious).Row
T_in = Range("A5:C" & Ligfin)


For Idx = 1 To UBound(T_in) Step Pas
     Cptr = Cptr + 1
     ReDim Preserve T_out(3, Cptr)
     For Col = 1 To 3
          T_out(Col, Cptr) = T_in(Idx, Col)
     Next
Next

'A SUPPRIMER APRES ESSAIS
Range("F5").Resize(Cptr, 3) = Application.Transpose(T_out) 'pour essais
Range("F5:H" & Cptr).Borders.Weight = xlThin
Application.ScreenUpdating = True
MsgBox "suppression effectuée en :" & Timer - start & " .sec."

'A ACTIVER APRES ESSAIS
'Range("A5:C150000").Clear
'Range("A5").Resize(Cptr, 3) = Application.Transpose(T_out) 'pour essais
'Range("A5:C" & Cptr).Borders.Weight = xlThin

Exit Sub
Erreur:
     MsgBox " la saisie doit être un nombre!", vbCritical
End Sub

Option Explicit
Option Base 1

Const FS = "Feuil3"
Const FB = "Feuil3"
' a partir de la ligne 5 on supprime 4 lignes toutes les 10 lignes
Const lideb = 5
Const nblisupp = 4
Const pas = 10

Const nbco = 3
Const codeb = 1

Public Sub SuppLignes2()
Dim lifin As Long, li2 As Long, nbpas As Long, li1 As Long, co As Long
Dim T, nbli As Long, lit As Long, s As Single
Application.ScreenUpdating = False
s = Timer
With Sheets(FS)
 lifin = .Cells(Rows.Count, codeb).End(xlUp).Row
 nbpas = 1 + (lifin - lideb) \ pas
 lifin = lideb + (nbpas) * pas + nblisupp - 1
 nbli = nbpas * (pas - nblisupp)
 ReDim T(1 To nbli, 1 To nbco)
 lit = 1
 On Error GoTo suite
 For li1 = lideb To lifin Step pas
   For li2 = li1 + nblisupp To li1 + pas - 1
     For co = 1 To nbco
       T(lit, co) = .Cells(li2, co)
     Next co
     lit = lit + 1
   Next li2
 Next li1
End With
Sheets(FS).Range(Cells(lideb, codeb), Cells(lifin, codeb + nbco - 1)).ClearContents
Sheets(FB).Cells(lideb, codeb).Resize(nbli, nbco) = T
Application.ScreenUpdating = True
MsgBox "temps mis " & Timer - s & " s"
End Sub

For x = 1 To 100000 Step 4

    Rows(x).Delete.
    x = x - 1

Next

Sub suppLig()
    Application.ScreenUpdating = False
    For lig = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -4
        Rows(lig).Delete
    Next
End Sub

Option Explicit

' a partir de la ligne 2 on supprime 4 lignes toutes les 10 lignes
Const lideb = 2
Const nblisupp = 4
Const pas = 10

' colonne renseignée
Const co = "A"

Public Sub SuppLignes()
Dim lifin As Long, li2 As Long, nbpas As Long, li1 As Long
Application.ScreenUpdating = False
With ActiveSheet
 lifin = .Range(co & Rows.Count).End(xlUp).Row
 nbpas = 1 + (lifin - lideb) \ pas
 lifin = lideb + (nbpas - 1) * pas + nblisupp - 1
 For li2 = lifin To lideb Step -pas
   li1 = li2 - nblisupp + 1
   .Rows(li1 & ":" & li2).Delete
 Next li2
End With
Application.ScreenUpdating = True
End Sub