Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim P As Range
If Sh.ListObjects.Count Then Set P = Sh.ListObjects(1).Range _
Else Set P = Sh.[A5].Resize(Sh.UsedRange.Rows.Count, Sh.Cells(5, Sh.Columns.Count).End(xlToLeft).Column)
If Intersect(Target, P.Resize(, 2)) Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
P.Sort P(1), xlAscending, Header:=xlYes 'tri alphabétique
On Error Resume Next 'si aucune SpecialCell
Intersect(P.Offset(2).Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow, P).Delete xlUp 'supprime les noms vides
If P(2, 1) = "" Then P.Rows(2).SpecialCells(xlCellTypeConstants).ClearContents 'traitement particulier de la 2ème ligne
On Error GoTo 0
P.RemoveDuplicates Array(1, 2), Header:=xlYes 'supprime les doublons
Application.EnableEvents = True 'réactive les évènements
With Sh.UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim t, d As Object, i&, P As Range, derlig&, x$, s
'---liste des noms et prénoms (avec séparateur)---
With Sheets("Liste Noms")
If Sh.Name = .Name Then Exit Sub
If .ListObjects.Count Then t = .ListObjects(1).Range.Resize(, 2) _
Else t = .[A5].Resize(.UsedRange.Rows.Count, 2) 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
If t(i, 1) <> "" Then d(t(i, 1) & Chr(1) & t(i, 2)) = ""
Next
End With
'---traitement de la feuille activée---
If Sh.ListObjects.Count Then Set P = Sh.ListObjects(1).Range Else _
Set P = Sh.[A5].Resize(Sh.UsedRange.Rows.Count, Sh.Cells(5, Sh.Columns.Count).End(xlToLeft).Column)
derlig = P.Rows.Count
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For i = 2 To derlig
x = P(i, 1) & Chr(1) & P(i, 2)
If d.exists(x) Then d.Remove x Else P(i, 1) = ""
Next
If d.Count Then
t = d.keys
For i = 0 To UBound(t)
s = Split(t(i), Chr(1))
P(derlig + i + 1, 1) = s(0)
If UBound(s) Then P(derlig + i + 1, 2) = s(1)
Next
End If
'---mise à jour---
Workbook_SheetChange Sh, P 'lance la macro
End Sub
