Autres Copier une cellule sur une autre feuille quand on clique dessus

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Or Target = "" Then Exit Sub
    If Not Intersect(Target, Range("A1:A1000")) Is Nothing Then
        Application.ScreenUpdating = False
        With Sheets("B")
            DL = 1 + .Range("A65500").End(xlUp).Row
            .Cells(DL, "A") = Target
            .Range("$A$1:$A$" & DL).RemoveDuplicates Columns:=1, Header:=xlYes
        End With
    End If
Fin:
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim col%
col = 1 'colonne des noms, à adapter
If Target.Row = 1 Or Target.Column <> col Or CStr(Target(1)) = "" Then Exit Sub
Cancel = True
With Sheets("b").Columns(1)
    .Cells(1) = "Nom"
    .Find("", , xlValues) = CStr(Target(1))
    .RemoveDuplicates 1, Header:=xlYes 'supprime les doublons
End With
End Sub