Supprimer 2 lignes sur 3

Bonjour.
Essaie :

Sub test()
Dim Ctr As Integer
Ctr = 1
Range("A1").Select
Do While ActiveCell <> ""
If Ctr > 1 Then
ActiveCell.Offset(1, 0).EntireRow.Delete
End If
If Ctr = 3 Then
Ctr = 1
ActiveCell.Offset(1, 0).Select
End If
Ctr = Ctr + 1
Loop
End Sub

Cordialement.
Daniel
"rva20" <pgl@pgl.be> a écrit dans le message de news:
1143793587.167768.254420@j33g2000cwa.googlegroups.com...

Bonjour,


J'ai un document de 600 lignes et j'aimerais supprimer automatiquement
2 lignes sur 3 (lignes 2 et 3, lignes 5 et 6, 8 et 9, .....)

Y a-t-il une solution?

Merci d'avance,

Rva20

Bonjour rva20

Tu peux essayer çà:

Sub Suppr_2_sur_3()
Const iMin As Integer = 1
Const iMax As Integer = 600
Dim i As Integer
Application.ScreenUpdating = False
For i = iMax To iMin Step -1
If Not i Mod 3 = 1 Then Rows(i).Delete shift:=xlUp
Next i
Application.ScreenUpdating = True
End Sub

(A copier dans un module quelconque) Corriges éventuellement les valeurs iMin et
iMax de la première et dernière ligne à traiter

@+

Yvan

"rva20" <pgl@pgl.be> a écrit dans le message de news:
1143793587.167768.254420@j33g2000cwa.googlegroups.com...

Bonjour,


J'ai un document de 600 lignes et j'aimerais supprimer automatiquement
2 lignes sur 3 (lignes 2 et 3, lignes 5 et 6, 8 et 9, .....)

Y a-t-il une solution?

Merci d'avance,

Rva20

"rva20" <pgl@pgl.be> a écrit dans le message de news:1143793587.167768.254420@j33g2000cwa.googlegroups.com...

Bonjour,


J'ai un document de 600 lignes et j'aimerais supprimer automatiquement
2 lignes sur 3 (lignes 2 et 3, lignes 5 et 6, 8 et 9, .....)

Y a-t-il une solution?

Sub Efface()
Dim Lig As Integer
Lig = 1
Cells(1, 1).Select
Do While ActiveCell.Offset(Lig + 1, 0) <> ""
ActiveCell.Offset(Lig + 1, 0).EntireRow.Delete
ActiveCell.Offset(Lig, 0).EntireRow.Delete
Lig = Lig + 1
Loop
End Sub

Merci à tous.
Je vais essayer cela aujourd'hui.


Rva

J'ai commencé par la solution de Michel_D et cela fonctionne super.

Encore un grand merci à tous. :-)