XL 2016 ajouter, une nouvelle feuille avec le contenu d'une cellule

[pascal21]

bonjour à tous
en colonne A
sur un double clic dans une cellule , je voudrais créer une nouvelle feuille qui prendrait le nom du contenu de la cellule double cliquée
si cette feuille est déjà crée alors aller directement à cette feuille
exemple contenu de la cellule "HJ-252-AA" la nouvelle feuille doit avoir pour nom HJ-252-AA
comment faire cela ?
je pourrais me servir des liens hypertexte mais ce n'est pas moi qui travaillerai sur le fichier et la liste en colonne A est évolutive
merci

 

[Nain porte quoi]

Hello

à mettre dans la feuille qui contient les noms des feuilles à créer

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    Dim Nom_Feuille As String
    Dim Feuille As Worksheet

    If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Value <> "" Then
        
        ' désactive le double clic
        Cancel = True
        Nom_Feuille = Target.Value
        
        ' cherche la feuille, si trouvé l'active et sort
        For Each Feuille In ThisWorkbook.Worksheets
            If Feuille.Name = Nom_Feuille Then
                Sheets(Nom_Feuille).Activate
                Exit Sub
            End If
        Next Feuille

        ' puisque pas trouvé la créer et l'activer
        With ThisWorkbook
            Set Feuille = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            Feuille.Name = Nom_Feuille
            Feuille.Activate
        End With
        
    End If
    
End Sub

 

[pascal21]

merci ça fonctionne parfaitement
maintenant est-il possible que chaque nouvelle feuille crée contienne la contenu (données et format) de la feuille "DATA",
MERCI

 

[fanfan38]

Bonjour
un fichier est TOUJOURS le bienvenu
La feuille data contient elle un tableau structuré?
Ci joint ma solution

A+ François

 

[job75]

Bonjour pascal21, le forum,

Testez cette macro :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Columns(1)) Is Nothing Or Target(1) = "" Then Exit Sub
Dim nom$, Sh As Object
nom = Left(Target(1), 31) 'le nom d'une feuille est limité à 31 caractères
Cancel = True
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set Sh = Sheets(nom)
If Sh Is Nothing Then
    Err = 0
    Sheets("DATA").Copy After:=Sheets(Sheets.Count)
    If Err Then MsgBox "Vous devez créer la feuille 'DATA' !", 48: Exit Sub
    ActiveSheet.Name = nom
    If Err Then
        MsgBox nom & " contient un caractère interdit dans les noms des feuilles !", 48
        ActiveSheet.Delete
        Me.Activate
    End If
Else
    Sh.Activate
End If
End Sub

A+