Bonsoir John,
voici déjà une solution à la demande de l'opérateur : il suffit de cliquer sur n'importe quelle cellule représentant la marque à scanner.
Je vais travailler maintenant à une version permettant les deux modes opératoires.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim tData, tExtract()
'
If Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
If Not Intersect(Target, Range("A2:A" & iRow)) Is Nothing Then
sData = Target
tData = Range("A1:F" & iRow).Value
For x = 2 To UBound(tData)
If tData(x, 1) = sData Then
iFlag = 0
iIdx = iIdx + 1
ReDim Preserve tExtract(3, iIdx)
If iIdx = 1 Then tExtract(0, iIdx - 1) = sData
tExtract(1, iIdx - 1) = tData(x, 2)
For y = 3 To 6
If tData(x, y) > iFlag Then
iFlag = tData(x, y)
iCol = y
End If
Next
tExtract(2, iIdx - 1) = tData(1, iCol)
End If
Next
With Worksheets("Synthèse")
iRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A2:C" & iRow).ClearContents
.Range("A2").Resize(iIdx, 3) = WorksheetFunction.Transpose(tExtract)
.Activate
End With
End If
Application.ScreenUpdating = True
'
End Sub
A+