afficher masquer des lignes code plus rapide

Sub masquer_ligne_Vide()
Dim cel As Range, T1
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Range("nd3:nd406").EntireRow.Hidden = False
  T1 = Timer
  
  For Each cel In Range("nd3:nd406")
    If cel = "2" Then cel.EntireRow.Hidden = True
  Next
  MsgBox "durée en s : " & Format(Timer - T1, " 0.00")
  
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Rows("13:500").Select
Selection.EntireRow.Hidden = False

Rows("13:500").Hidden = False

Private Sub Label14_Click()
Usf2.Show 0
Dim I&, Tb As Variant, Plg As Range
With Sheets("Pointages")
    Tb = .Range("NC1:NC500")
    For I = 13 To 500
        If Tb(I, 1) = 1 Then Set Plg = Union(.Rows(I), IIf(Plg Is Nothing, .Rows(I), Plg))
    Next I
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    .Rows.Hidden = False
    If Not Plg Is Nothing Then Plg.Rows.Hidden = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End With
Unload Usf2
End Sub

 Tb = .Range("NC1:NC500")

Sub MEF_Cellule_2_Blanc()
' MEF_Cellue_2_Blanc Macro
    'Cells.FormatConditions.Delete
    Columns("A:Z").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

Sub MasqueP()
Application.ScreenUpdating = False
Cells.EntireRow.AutoFit
On Error GoTo fini
Derl = Cells(65536, 1).End(xlUp).Row
With ActiveSheet.Range("H2:H" & Derl)
Set C = .Find("P", LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.EntireRow.Hidden = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
fini:
Application.ScreenUpdating = True
End Sub
Sub MasqueW()
Application.ScreenUpdating = False
Cells.EntireRow.AutoFit
On Error GoTo fini
Derl = Cells(65536, 1).End(xlUp).Row
With ActiveSheet.Range("H2:H" & Derl)
Set C = .Find("W", LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.EntireRow.Hidden = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
fini:
Application.ScreenUpdating = True
End Sub