Changer le private sub

Bonjour

Dans le code ci-dessous comment procéder pour supprimer le double click par uniquement la touche Enter quans un nouveau nom est inséré en colonne A

Avec mes remerciements

Cordialement

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 fin
    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
    On Error GoTo 0
End Sub

Bonjour,

regarde l'événement Worksheet_Change

eric

Bonjour joco7915, le forum,

Essaie avec:

Private Sub Worksheet_Change(ByVal Target As Range)

Cordialement,

Re bonjour

Je viens de faire un essai un bug sur cette ligne

Cancel= True message Variable non définie

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

Bravo

il faut s'interdire les On Error Goto destinés à cacher la misère.

Il ne faut les utiliser que pour faire un vrai traitement d'erreur que l'on maitrise.

Tu as laissé BeforeDoubleClick dans ton collé, un oubli sans doute.

Utilise la balise </> (icones au-dessus du post en édition) quand tu colles un code dans le forum, qu'il reste plus facile à lire avec l'indentation conservée.

eric

Merci à tous

J'ai résolu le souci

oublié de modifié le private sub

Cordialement