XL 2019 Extraction de caractères et les afficher dans une cellule

DJISA

XLDnaute Occasionnel
Bonjour, le Forum!
Nous voulons extraire les deux premiers caractères des noms de feuilles et les afficher dans une cellule donnée. Cette opération doit être simultanée avec la création des onglets. Les onglets seront créés à partir d'une liste.
Nous joignons un fichier.
Merci
DJISA
 

DJISA

XLDnaute Occasionnel
Bonjour Fred0o, le Forum
J'avais oublié de joindre le fichier dans la premier discussion. Mais nous l'avons envoyé par la suite.
Toutefois le joignons encore pour vous.
Merci
DJISA
 

Pièces jointes

  • Extraction de caractères.docx
    13.2 KB · Affichages: 3

DJISA

XLDnaute Occasionnel
Bonjour Mdo 100, Le Forum
Nous avons testé le code mais il ne fonctionne pas. Ensuite il me semble que vous avez oublié que les 2 caractères extraits doivent être affichés dans une cellule donnée, par exemple en F5 comme dans le fichier.
Merci
DJISA
 

DJISA

XLDnaute Occasionnel
Bonjour mdo100, Le forum
Nous joignons un nouveau fichier avec le code créant les onglets. Le fichier correspond au résultat attendu.
Le code ci-dessous crée les onglets. Mais que faut-il y ajouter pour extraire les caractères 6A et 6B des noms d'onglets 6ASEM1, 6ASEM2..., 6BSEM1, 6BSEM1 et les inscrire dans la cellule D9 de chaque onglet créé? Bref le fichier joint vous édifiera davantage.
VB:
Sub Create_ong()               
Dim DerLig As Long, i As Integer               
 
DerLig = Feuil7.Range("B" & Rows.Count).End(xlUp).Row               
Application.ScreenUpdating = False               
    For i = DerLig To 2 Step -1               
        Sheets("Modele").Copy After:=Feuil7               
        ActiveSheet.Name = Feuil7.Cells(i, 2)               
    Next i               
Application.ScreenUpdating = True               
End Sub
Merci
DJISA
 

Pièces jointes

  • Extraction.xlsm
    33.9 KB · Affichages: 5

Staple1600

XLDnaute Barbatruc
Re

•>DJISA
Donc ceci devrait faire l'affaire, non ?
VB:
Sub Creation_onglets2()
Dim DerLig As Long, i As Long
DerLig = Feuil7.Range("B" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
    For i = DerLig To 2 Step -1
        Sheets("Modele").Copy After:=Feuil7
        ActiveSheet.Name = Feuil7.Cells(i, 2)
        ActiveSheet.[D9] = Left(ActiveSheet.Name, 2)
    Next i
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 730
Messages
2 081 989
Membres
101 856
dernier inscrit
Marina40