Création de feuilles en nommant une cellule

[dominique35]

Bonjour.

Après plusieurs recherches j'ai trouvé quelques petites choses mais pas vraiment ce que je recherche.
J'aimerais dans la mesure du possible, que quand j'inscris dans une cellule un nom, une feuille portant le nom de la cellule se crée automatiquement et importe les données en même temps.
Je joint un fichier pour plus explications
Merci.

 

[Softmama]

Re : Création de feuilles en nommant une cellule

Bonjour,

Vois si le fichier joint réalise ce que tu souhaites, avec cette macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
'Macro qui intervient lorsqu'une cellule de la ligne 3 est modifiée
If Right$(Target.Address, 2) = "$3" And Target <> "" Then
    Sheets.Add 'Ajout d'une feuille
    With ActiveSheet
        .Move after:=Sheets(Sheets.Count) 'qu'on place dernière
        .Name = Target 'et qui prend le nom de la cellule
    End With
'Recopie des 2 colonnes dans le nouvelle feuille :
    Sheets(1).Columns(1).Copy Destination:=Sheets(Sheets.Count).Range("A1")
    Sheets(1).Columns(Target.Column).Copy Destination:=Sheets(Sheets.Count).Range("B1")
End If
End Sub

 

[dominique35]

Re : Création de feuilles en nommant une cellule

Bonjour et merci, c'est ce que je recherche, par-contre est il possible, que quand je change les donnés de la colonne B en feuil1 et données s'actualise dans la feuille TOTO en colonne B

 

[Softmama]

Re : Création de feuilles en nommant une cellule

Bonjour;

Oui c'est possible, rajoute simplement ces 2 lignes avantle End if en fin de macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Right$(Target.Address, 2) = "$3" And Target <> "" Then
    Sheets.Add
    With ActiveSheet
        .Move after:=Sheets(Sheets.Count)
        .Name = Target
    End With
    Sheets(1).Columns(1).Copy Destination:=Sheets(Sheets.Count).Range("A1")
    Sheets(1).Columns(Target.Column).Copy Destination:=Sheets(Sheets.Count).Range("B1")
ElseIf Target.Column > 1 Then
    If Cells(3, Target.Column) <> "" Then Worksheets(Cells(3, Target.Column).Text).Cells(Target.Row, Target.Column) = Target
End If
End Sub