Lenteur macro

Option Compare Text
Sub supLignesRapide2()
  Application.ScreenUpdating = False
  a = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "muac" Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

Dim Wsh As Worksheet, TV(), L As Long, RngDel
Set Wsh = Worksheets("A")
TV = Intersect(Wsh.Columns(20), Wsh.UsedRange).Value
For L = 2 To UBound(TV, 1)
   If Not TV(L, 1) Like "*MUAC*" Then
      If RngDel Is Nothing Then
         Set RngDel = Wsh.Rows(L)
      Else
         Set RngDel = Union(RngDel, Wsh.Rows(L))
         End If
      End If
   Next L
If Not RngDel Is Nothing Then RngDel.Delete

Option Compare Text
Sub supLignesRapide2()
  Application.ScreenUpdating = False
  a = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "muac" Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  Stop
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub