Private Sub Worksheet_Change(ByVal Target As Range)
Dim critere$, tablo, resu(), i&, n&
Application.EnableEvents = False 'désactive les évènements
If [B2] = "" Then [C2] = "": GoTo 1
If Not Intersect(Target, [B2]) Is Nothing Then [C2] = ""
critere = LCase(Left([B2], 1) & Chr(1) & "*" & CStr([C2])) & "*"
tablo = Sheets("Données Techniques").[A2].CurrentRegion.Resize(, 3) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 2)
For i = 2 To UBound(tablo)
If LCase(tablo(i, 3) & Chr(1) & tablo(i, 1)) Like critere Then
n = n + 1
resu(n, 1) = tablo(i, 3)
resu(n, 2) = tablo(i, 1)
End If
Next
'---restitution---
1 With [B4] '1ère cellule de restitution
If n Then .Resize(n, 2) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
Columns(3).AutoFit 'ajustement largeur
Application.EnableEvents = True 'réactive les évènements
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row > 3 And Cells(Target.Row, 2) <> "" Then
Cancel = True
[C2] = Cells(Target.Row, 3)
ElseIf Target.Row = 2 Then
If [B2] = "" Or Application.CountIf(Range("C4:C" & Rows.Count), [C2]) = 0 Or [D2] = "" Then Exit Sub
Cancel = True
With Sheets(CStr([B2]))
.Cells(.Rows.Count, 1).End(xlUp)(2).Resize(, 2) = [C2:D2].Value
.Columns(1).AutoFit
.Activate
End With
End If
End Sub