Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, d As Object, a, i%, x$, j%
Set r = Intersect(Target, Range("A2:D" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Set r = Intersect(r.EntireRow, [A:A])
'---liste sans doublon des agences de Target---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each r In r 'si entrées multiples (copier-coller)
If r <> "" Then d(r.Value) = ""
Next r
If d.Count = 0 Then Exit Sub
a = d.keys
'---création des feuilles---
On Error Resume Next
For i = 0 To UBound(a)
If IsError(Sheets(a(i))) Then
Application.ScreenUpdating = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(a(i))
End If
Next i
'---classement des onglets créés---
If Not Application.ScreenUpdating Then
For i = 2 To Sheets.Count 'on ne touche pas au 1er onglet
x = LCase(Sheets(i).Name)
For j = i + 1 To Sheets.Count
If LCase(Sheets(j).Name) < x Then Sheets(j).Move Before:=Sheets(i)
Next j, i
Me.Activate
End If
End Sub