Private Sub Worksheet_Change(ByVal Target As Range)
Dim Recherche1 As Range, Recherche2 As Range, Recherche As Range, P1 As Range, P2 As Range, P As Range
Dim Dates As Range, c As Range, Q As Range, R As Range
Set Recherche1 = [T11:X11]
Set Recherche2 = [Y11:Z11]
Set Recherche = Union(Recherche1, Recherche2)
If Intersect(Target, Recherche) Is Nothing Then Exit Sub
Set P1 = [E:I]
Set P2 = [J:K]
Set P = Union(P1, P2)
Set Dates = [D:D]
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
'Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).Delete xlUp 'RAZ
Recherche.Offset(1).Resize(Rows.Count - Recherche.Row, Recherche.Columns.Count + 1).ClearContents 'RAZ
For Each c In Recherche1
If c <> "" Then
P1.Replace c, "#N/A", xlWhole
Set Q = Nothing
Set Q = P1.SpecialCells(xlCellTypeConstants, 16)
If Q Is Nothing Then Exit Sub
Q = c
Set Q = Intersect(Q.EntireRow, P)
If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
If R Is Nothing Then Exit Sub
End If
Next
For Each c In Recherche2
If c <> "" Then
P2.Replace c, "#N/A", xlWhole
Set Q = Nothing
Set Q = P2.SpecialCells(xlCellTypeConstants, 16)
If Q Is Nothing Then Exit Sub
Q = c
Set Q = Intersect(Q.EntireRow, P)
If R Is Nothing Then Set R = Q Else Set R = Intersect(Q, R)
If R Is Nothing Then Exit Sub
End If
Next
'---résultat---
R.Copy Recherche(2, 1)
Intersect(R.EntireRow, Dates).Copy Recherche(2, Recherche.Columns.Count + 1)
End Sub