Copier une feuille à partir d'un template

Bonjour, je suis nouveau en VBA.

J'essaye de générer une fiche commercial au double-clic sur une cellule à partir d'un template qui est caché mais si la fiche commerciale a déjà été générée, cela crée un message d'erreur. Je ne sais pas d'où vient ce message d'erreur. Je souhaiterais ,si la feuille a déjà été générée , qu'on arrive directement à la feuille qui existe déjà.

Pourriez-vous m'aider?

Merci

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.DisplayAlerts = True

Sheets("fiche").Visible = True

If Not Application.Intersect(Target, Range("A5:A250")) Is Nothing Then

Sheets("fiche").Range("d5") = Target

Sheets("fiche").Select

[Client].Select

Application.DisplayAlerts = False

NomFeuille = "Fiche " & Sheets("fiche").Range("D5")

Sheets("fiche").Copy After:=Sheets(Sheets.Count)

On Error GoTo Existe

ActiveSheet.Name = NomFeuille

'Worksheets(Worksheets.Count).Delete

On Error GoTo 0

Existe:

If Err.Number <> 0 Then

Worksheets(Worksheets.Count).Delete

Sheets(NomFeuille).Select

Sheets("fiche").Visible = False

Resume

End If

Sheets("fiche").Visible = False

Application.DisplayAlerts = True

End If

End Sub

Bonjour,

Je ne sais pas si j'ai lu assez attentivement pour comprendre ton problème, mais je n'ai aucun message d'erreur en réitérant une création de fiche... !??

Par contre, même si cela ne provoque pas d'erreur d'exécution, ta gestion d'erreur n'est pas très cohérente : une ligne Exit Sub s'impose toujours avant l'étiquette Existe: (inutile d'exécuter ce fragment de code hors erreur...), le test pour savoir s'il y a erreur, justifié après une instruction On Error Resume Next ne l'est pas à cet emplacement si l'on n'y accède que lorsque justement il y a erreur (et erreur pré-identifiée), et l'activation de la fiche, de même que le masquage du modèle devraient être hors gestionnaire d'erreur...

Une imbrication d'instructions à exécuter et d'instructions de gestion d'erreur peut toujours générer des résultats inattendus, sinon des erreurs d'exécution. Je pense qu'il serait sage d'éviter un tel mélange.

Cordialement.

Bonjour MrFerrand

Merci pour votre réponse.

Pourriez-vous me dire ou placer les erreurs car j'ai tenté de placer

ActiveSheet.Name = NomFeuille

'Worksheets(Worksheets.Count).Delete

Sheets("fiche").Visible = False

avant On Error GoTo Existe mais ca ne fonctionne pas.

Merci

Bonjour,

Un peu épurée, à voir :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Sheets("fiche").visible = True
    If Not Application.Intersect(Target, Range("D9:D152")) Is Nothing Then
        NomFeuille = "Fiche " & Target.Value
        Application.DisplayAlerts = False
        Sheets("fiche").Copy after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Range("D5") = Target.Value
            On Error GoTo Existe
            .Name = NomFeuille
            On Error GoTo 0
        End With
        Sheets("fiche").visible = False
        Sheets(NomFeuille).Activate
        Application.DisplayAlerts = True
        Cancel = True
    End If
    Exit Sub
Existe:
    Worksheets(Worksheets.Count).Delete
    Resume Next
End Sub

J'avais eu l'intention de laisser les lignes supprimées ou modifiées en la invalidant seulement, pour comparaison ultérieure, mais tu m'as fait un peu galérer avec ta définition de plage à partir de D11, pendant que je m'escrimais à double-cliquer sur D10 . Le temps que je finisse par le voir , j'avais effacé les lignes en question pour y voir plus clair...

Cordialement.

J'ai réussi à corriger mon problème en faisant autrement.

Function FeuilExiste(F As String) As Boolean
    On Error Resume Next
    FeuilExiste = Not Sheets(F) Is Nothing
End Function

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.DisplayAlerts = True
Sheets("fiche").visible = True

If Not Application.Intersect(Target, Range("D17:D250")) Is Nothing Then
Sheets("fiche").Range("d5") = Target
Sheets("fiche").Select
[Client].Select

Application.DisplayAlerts = False

Dim NomFeuille As String
NomFeuille = "Fiche " & Sheets("fiche").Range("D5")

    If FeuilExiste(NomFeuille) Then
        'MsgBox "L'onglet " & Feuil & " existe déjà dans le classeur actif."
        Sheets(NomFeuille).Select
    Else
        'MsgBox "L'onglet " & Feuil & " n'existe pas dans le classeur actif."
        'Sheets(NomFeuille).Select
        Sheets("fiche").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = NomFeuille
    End If

End If
Sheets("fiche").visible = False
End Sub

et à priori, je n'ai plus d'erreur.

Merci MFerrand, ça marche parfaitement aussi.