Sub Sup_Act()
Dim Plage As Range, Lgn&
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets('EBT2.3')
Set Plage = .Range('A1', .Range('D1').End(xlDown))
End With
'Tri des activités
With Plage
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=True, MatchCase:=False
'supprimer les activités différentes de 20,45,115,405 et 500
For Lgn = .Rows.Count To 2 Step -1
Select Case .Cells(Lgn, 2)
Case 20, 45, 115, 405, 500
Case Else
Range(.Cells(Lgn, 1), .Cells(Lgn, 20)).Delete xlUp
End Select
Next Lgn
End With
Application.ScreenUpdating = True
End Sub