J'ai trouvé le bon code il fallait supprimer 2 lignes
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Integer
Dim Ws As Worksheet
Dim Plage As Range
Dim Prenom
On Error GoTo 'ligne a supprimer
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value = "" Then Exit Sub
'Boucle sur les feuilles du classeur.
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name = Target.Value Then 'même nom
MsgBox "Une feuille existe dèjà à ce nom!", vbExclamation, "Ajout feuille"
Exit Sub
End If
Next Ws
'---------------Copie modele en dernier--------------------
With Sheets("Modele")
.Select
.Range("A1") = Target.Value
.Copy After:=Sheets(Sheets.Count)
.Range("A1") = ""
End With
' renomme cette feuille avec le nom
Sheets(Sheets.Count).Name = Target.Value
'-----------------------------------------------
End If
Sheets("feuil1").Activate
fin:
Application.ScreenUpdating = True
Cancel = True 'ligne a supprimer
On Error GoTo 0 a supprimer
End Sub
Merci pour votre aide