Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address <> [lien].Address Then Exit Sub 'cellule nommée
Dim tablo, ncol%, d As Object, i&, n&, lig&, j%
Cancel = True
tablo = [lien].CurrentRegion.Offset(1)
ncol = UBound(tablo, 2)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(tablo) - 1
If d.exists(tablo(i, 1)) Then
n = n + 1
If IsNumeric(d(tablo(i, 1))) Then '1er des doublons
lig = d(tablo(i, 1))
d(tablo(i, 1)) = ""
For j = 1 To ncol
tablo(n, j) = tablo(lig, j)
Next j
n = n + 1
End If
For j = 1 To ncol
tablo(n, j) = tablo(i, j)
Next j
Else
d(tablo(i, 1)) = i 'mémorise la ligne
End If
Next i
With Feuil2 'CodeName de la feuille "Résultat"
.Cells.Delete 'RAZ
[lien].CurrentRegion.Rows(1).Copy .[A1] 'titres
.[A1].ClearComments
.Columns(4).NumberFormat = "@" 'format Texte à cause des $2
If n Then .[A2].Resize(n, ncol) = tablo 'restitution
.Columns(4).NumberFormat = "General"
.[A2].CurrentRegion.Borders.Weight = xlHairline 'bordures
.[A:A].HorizontalAlignment = xlLeft
.Columns.AutoFit 'ajustement largeur
.Activate
End With
End Sub