Cellule = onglet

Résolu

JCB40 -

Bonjour,
Dans l'exemple ci-dessous j'ai en colonne A des noms je souhaiterais avoir un code qui lorsque
j'ajoute un nom ,m'active une nouvelle feuille et que l'onglet de cette feuille ainsi que la cellule A1
portent le nom que je viens d'ajouter.
https://www.cjoint.com/c/JClpUu2OPPf
Merci pour votre aide
Cordialement

Configuration: Windows / Firefox 73.0

--
Commence par faire le nécessaire ,puis fait ce qu'il est possible de faire et tu réaliseras l'impossible sans t'en apercevoir. Saint François d'Assise

Afficher la suite

4 réponses

cs_Le Pivert Contributeur

bonjour,

a mettre dans le module de la feuille1. Se déclenche au double clic dans la colonne A (nom prenom)

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Integer
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Value = "" Then Exit Sub
Sheets.Add After:=Sheets(Sheets.Count)
' renomme cette feuille avec le nom
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = Target.Value
' boucle sur les colonnes 1 a 5 de feuil1
    For c = 1 To 5 ' REMPLACER le 5 par le n° de la dernière colonne
    ' place en ligne 1 de la nouvelle feuille les titres
    Sheets(Sheets.Count).Cells(1, c) = Sheets("Feuil1").Cells(1, c)
      ' place en ligne 2 de la nouvelle feuille l'information de Feuil1
    Sheets(Sheets.Count).Cells(2, c) = Sheets("Feuil1").Cells(Target.Row, c)
    Next
 ' Repositionnement sur Feuil 1
Sheets("Feuil1").Select
End If
End Sub

JCB40 Auteur
Bonjour
Merci pour ta solution qui va en partie.
Ce que j'aurais souhaité c'est d'avoir sur la ligne1 uniquement en cellule A1 le nom et prénom ,le reste à partir de la
ligne 2.
Est-ce possible?
Cordialement

0

cs_Le Pivert Contributeur

@JCB40comme ceci:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Integer
Dim Ws As Worksheet
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
Sheets.Add After:=Sheets(Sheets.Count)
' renomme cette feuille avec le nom
Sheets(Sheets.Count).Name = Target.Value
Sheets(Sheets.Count).Range("A1").Value = Target.Value
' boucle sur les colonnes 1 a 5 de feuil1
    For c = 1 To 5 ' REMPLACER le 5 par le n° de la dernière colonne
    ' place en ligne 1 de la nouvelle feuille les titres
   ' Sheets(Sheets.Count).Cells(1, c) = Sheets("Feuil1").Cells(1, c)
      ' place en ligne 2 de la nouvelle feuille l'infomation de Feuil1
    Sheets(Sheets.Count).Cells(2, c + 1) = Sheets("Feuil1").Cells(Target.Row, c + 1)
    Next
 ' Repositionnement sur Feuil 1
Sheets("Feuil1").Select
End If
End Sub

Voilà

@+ Le Pivert

JCB40 Auteur
@cs_Le PivertRe bonjour
On y est presque voir le fichier ci-dessous il y a les explications sur 2 feuilles
Il faudrait que dans la feuille créée figure tout ce qui se trouve en colonne B C D E
https://www.cjoint.com/c/JCmkZYNxcCf
Crdlt

0

cs_Le Pivert Contributeur

@JCB40Avec les commentaires, c'est facilement adaptable!

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Integer
Dim Ws As Worksheet
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
Sheets.Add After:=Sheets(Sheets.Count)
' renomme cette feuille avec le nom
Sheets(Sheets.Count).Name = Target.Value
Sheets(Sheets.Count).Range("A1").Value = Target.Value
' boucle sur les colonnes 2 a 5 de feuil1
    For c = 2 To 5 ' REMPLACER le 5 par le n° de la dernière colonne
    ' place en ligne 2 de la nouvelle feuille les titres
    Sheets(Sheets.Count).Cells(2, c) = Sheets("Feuil1").Cells(1, c)
      ' place en ligne 3 de la nouvelle feuille l'infomation de Feuil1
    Sheets(Sheets.Count).Cells(3, c) = Sheets("Feuil1").Cells(Target.Row, c)
Next
 ' Repositionnement sur Feuil 1
Sheets("Feuil1").Select
End If
End Sub

@+ Le Pivert

JCB40 Auteur
@cs_Le PivertUn nouvelle exemple du fichier final
https://www.cjoint.com/c/JCmmLPPujmf
Crdlt

0

Réponse 2 / 4
JCB40 Auteur
Bonjour
Merci pour ton aide
Exactement ce que je voulais .
Par contre est-il possible que dans les nouvelles feuilles le tableau soit de la même dimension
que le modèle?
Cordialement

0
Réponse 3 / 4
JCB40 Auteur
Re
Je viens de constater que les copies de la feuille Modèle ne reprennent pas les formules qu'il y a dedans.

0
1. f894009
  
  Bonjour,
  
  les formules qu'il y a dedans.
  Ok, je vais modifier aussi pour avoir le meme tableau (taille)
  
  suite:
  fichier modifie:
  https://mon-partage.fr/f/f6NBEfsg/
  
  0
2. JCB40 Auteur
  
  @f894009Bonsoir
  
  Merci pour ton aide tout fonctionne nickel.
  Bon WE
  Cordialement
  
  0
Réponse 4 / 4
JCB40 Auteur
Bonjour
Tout fonctionne mais l'histoire du Double Click pas très pratique.
Est-il possible de modifier en tapant uniquement sur Enter quand un nouveau nom est inséré?
Cordialement

0
1. f894009
  
  Bonjour,
  
  Double Click:
  C'est ce que je vous ai ecrit post 11.
  Je vous arrange ca
  
  0
2. JCB40 Auteur
  
  @f894009Bonjour
  
  Ok merci
  
  0
3. f894009
  
  @JCB40Re,
  Par contre, demande un peu de reflexion car si creation des l'ajout d'un nom sans les autres infos, ca va pas le faire
  
  Question: si vous entrez tous vos participants et seulement a la fin click sur un bouton pour créer tous les onglets, Ok ou pas
  
  0
4. JCB40 Auteur
  
  @f894009Si plus facile avec un bouton Ok pas de problème
  Mais en cas d'oubli d'un nom après avoir cliqué sur le bouton pourra-t-on ajouter ce nom et créer son onglet?
  
  0
5. f894009
  
  @JCB40Re,
  Mais en cas d'oubli d'un nom
  Oui, puisqu'il y a test si nom onglet déjà exitant
  
  0

Cellule = onglet

4 réponses

Discussions similaires

Newsletters