Suppression de lignes.

Sub Deleteif_findwordtrue 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Myrange, Urng As Range,C, Lastrow&, Quoi as string
Dim Choix&, Lr&
choix= 0
Lr = Cells(Rows.Count, "A").End(xlUp).Row 
Set myrange =Feuil1.Range("A1:A" & Lr) 
Quoi=ucase("Test")
For Each c In myrange 
   If UCase(c.text) like quoi Then 
        If Urng Is Nothing Then 
            Set Urng = c.EntireRow 
        Else 
            Set Urng = Union(Urng, c.EntireRow) 
        End If 
    End If 
Next 
If Not Urng Is Nothing and choix =1 Then 
Urng.interior.colorindex= 36
else 
Urng.Delete
End If 
set Urng= Nothing :set myrange= Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

Sub supLignesRapide()
Dim c As Range
With ActiveSheet
    .Range("A1").CurrentRegion.Sort key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes
    Set c = .Columns(1).Find(What:="B", LookIn:=xlValues)
    If Not c Is Nothing Then
        .Range(c, .Cells(.Rows.Count, 1).End(xlUp)).EntireRow.Delete xlShiftUp
    End If
End With
End Sub

Sub Macro1()

' Macro enregistrée le 09/01/2012 par l'agrafe
'
Application.ScreenUpdating = 0
With Range("A2:A2").Resize([A65536].End(xlUp).Row)
.FormulaR1C1 = "=IF(ABS(RC[34])<0.5,0,""B"")"
.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
End With
End Sub