Private Sub cacherligne()
Dim Target As Range
Dim trouve As Byte
Dim data1 As String
Dim cellule As Range
If flag = True Then Exit Sub
Application.ScreenUpdating = False
Dim dl1 As Long ' dernière ligne
Set Target = Sheets("Ao").Range("d2")
With Sheets("Cause ")
dl1 = .Range("d65536").End(xlUp).Row
.Rows("2:" & dl1).EntireRow.Hidden = False
If Not Intersect(Target, Range("d2")) Is Nothing Then
For Each cellule In .Range("d2:d" & dl1)
trouve = 0
If cellule.Offset(0, 5).Value = Target.MergeArea(1).Value Then trouve = 1
If cellule.Offset(0, 6).Value = Target.MergeArea(1).Value Then trouve = 1
If trouve = 1 And cellule = "ZAOG" Then
Else
.Rows(cellule.Row).EntireRow.Hidden = True
End If
Next cellule
Application.ScreenUpdating = True
End If
flag = False
End With
End Sub
Option Explicit
Private Sub cacherligne()
Dim Target As Range
Dim trouve As Byte
Dim data1 As String
Dim cellule As Range
Application.ScreenUpdating = False
Dim dl1 As Long ' dernière ligne
Set Target = Sheets("Ao").Range("d2")
With Sheets("Cause ")
dl1 = .Range("d65536").End(xlUp).Row
.Rows("2:" & dl1).EntireRow.Hidden = False
For Each cellule In .Range("d2:d" & dl1)
trouve = 0
If cellule.Offset(0, 5).Value = Target.MergeArea(1).Value Then trouve = 1
If cellule.Offset(0, 6).Value = Target.MergeArea(1).Value Then trouve = 1
If trouve = 1 And cellule = "ZAOG" Then
Else
.Rows(cellule.Row).EntireRow.Hidden = True
End If
'colonne H [COLOR="Red"]et[/COLOR] K si égales la date de la cellule D2 de la feuille « AO »
If .Rows(cellule.Row).EntireRow.Hidden = False And _
(cellule.Offset(0, 4).Value = Target.MergeArea(1).Value [COLOR="Red"]And[/COLOR] _
cellule.Offset(0, 7).Value = Target.MergeArea(1).Value) Then _
.Rows(cellule.Row).EntireRow.Hidden = True
Next cellule
Application.ScreenUpdating = True
End With
End Sub