Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:E3]) Is Nothing Or [E2] = "" Then Exit Sub
Dim w As Worksheet
On Error Resume Next
Set w = Sheets(CStr([E2]))
On Error GoTo 0
If w Is Nothing Then
If [E3] = "" Then [E3].Select: MsgBox "Entrez l'évaluateur...": Exit Sub
'---création de la feuille---
With Sheets.Add(After:=Sheets(Sheets.Count))
.Name = [E2]
Cells.Copy .[A1] 'copie toutes les cellules
[A1].Copy .[A1] 'allège la mémoire
.[E2:E3].Validation.Delete 'supprime les listes
.[F2:H2].Clear 'supprime les notas
End With
Else
w.Activate
End If
End Sub