INSCRIRE NOM

=SIERREUR(INDEX($E$1:$E$100;EQUIV(0;INDEX(NB.SI($A$1:$A1;$E$1:$E$100););0));"")

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, resu(), d As Object, n&, i&
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
t = Range("E1", Range("E" & Rows.Count).End(xlUp)(2)) 'tableau, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(t) + 1, 1 To 1)
Set d = CreateObject("Scripting.Dictionary")
d("NOMS") = "": resu(1, 1) = "NOMS": n = 1
For i = 1 To UBound(t)
    If t(i, 1) <> "" And Not d.exists(t(i, 1)) Then
        d(t(i, 1)) = ""
        n = n + 1
        resu(n, 1) = t(i, 1)
    End If
Next
[A1].Resize(n) = resu
Range("A" & n + 1 & ":A" & Rows.Count).ClearContents 'RAZ en dessous
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, resu(), d As Object, n&, i&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
t = Range("E1", Range("E" & Rows.Count).End(xlUp)(2)) 'tableau, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(t) + 1, 1 To 1)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
d("NOMS") = "": resu(1, 1) = "NOMS": n = 1
For i = 1 To UBound(t)
    If t(i, 1) <> "" And Not d.exists(t(i, 1)) Then
        d(t(i, 1)) = ""
        n = n + 1
        resu(n, 1) = Application.Proper(t(i, 1)) 'nom propre
    End If
Next
[A:A].ClearContents
[A1].Resize(n) = resu
[A1].Resize(n).Sort [A1], xlAscending, Header:=xlYes 'tri alphabétique
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Columns(5)) Is Nothing Then
      Application.ScreenUpdating = False
      Worksheets("Feuil1").Activate
      Columns(1).Clear: On Error Resume Next
      With Range("a1:a" & Cells(Rows.Count, "e").End(xlUp).Row)
         .FormulaR1C1 = "=IF(RC[4]="""",NA(),TRIM(PROPER(RC[4])))": .Value = .Value
      End With
      Cells(1, 1).Insert xlShiftDown: Cells(1, 1) = "NOMS"
      With Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row)
         .Sort key1:=Range("a1"), order1:=xlAscending, Header:=xlYes
         .RemoveDuplicates 1, xlNo
         .SpecialCells(xlCellTypeConstants, xlErrors).Delete xlShiftUp
      End With
      Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).Borders.LineStyle = xlContinuous
   End If
End Sub

   .FormulaR1C1 = "=TRIM(PROPER(RC[4]))": .Value = .Value

        .SpecialCells(xlCellTypeConstants, xlErrors).Delete xlShiftUp