Salut l'équipe,
autre écriture avec un démarrage de la macro sur un double-clic...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract()
'
Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row).Interior.Color = xlNone
Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row).ClearContents
For x = 1 To 5
tData = Range(Chr(64 + x) & "2:" & Chr(64 + x) & Range(Chr(64 + x) & Rows.Count).End(xlUp).Row).Value
For y = 1 To UBound(tData, 1)
iOK = 0
If iIdx > 0 Then
For Z = 0 To UBound(tExtract)
If tData(y, 1) = tExtract(Z) Then iOK = 1
Next
End If
If iOK = 0 Then
iIdx = iIdx + 1
ReDim Preserve tExtract(iIdx)
tExtract(iIdx - 1) = tData(y, 1)
End If
Next
Next
Range("F2").Resize(iIdx, 1).Value = WorksheetFunction.Transpose(tExtract)
Range("F2").Resize(iIdx, 1).Sort key1:=Range("F2"), order1:=xlAscending, Orientation:=xlSortColumns
Range("F2").Resize(iIdx, 1).Interior.Color = Range("F1").Interior.Color
'
End Sub
A+