Private Sub Worksheet_Change(ByVal Target As Range)
'Feuil2 est le CodeName de la feuille modèle à copier
Dim r As Range, t, repere(), w As Worksheet, i As Variant
Set r = Range("B6", Range("B" & Rows.Count).End(xlUp)(7))
If Intersect(Target, r) Is Nothing Then Exit Sub
t = r 'matrice, plus rapide
ReDim repere(1 To UBound(t), 1 To 1)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppresion de feuilles et repérage---
For Each w In Worksheets
If w.CodeName <> Me.CodeName And w.CodeName <> "Feuil2" Then
i = Application.Match(w.Name, r, 0)
If IsNumeric(i) Then repere(i, 1) = 1 Else w.Delete
End If
Next
'---Ajout de feuilles---
For i = 1 To UBound(t)
If t(i, 1) <> "" And repere(i, 1) = "" Then
Feuil2.Copy After:=Sheets(Sheets.Count)
On Error Resume Next 'en cas de caractère interdit
Sheets(Sheets.Count).Name = CStr(t(i, 1))
If Sheets(Sheets.Count).Name <> CStr(t(i, 1)) Then _
MsgBox "Feuille déjà créée ou caractère interdit en " & r(i).Address(0, 0), 48 _
: Sheets(Sheets.Count).Delete
On Error GoTo 0
End If
Next
Me.Activate
End Sub