XL 2013 MACRO CREATION FEUILLE EXCEL SUR LA BASE D'UN MODELE AVEC REFERENCE

kaisermpt

XLDnaute Occasionnel
Bonjour,

Je me permets de vous solliciter concernant le code d'une macro.

Pour simplifier (mon fichier est beaucoup plus complexe) j'ai besoin d'une macro me permettant de dupliquer une fiche modèle (MODELE) et en insérant selon dans la zone de lA fiche créé le nom du pays.

Concrètement, quand je clique sur le bouton "Fiche FRANCE", dans l'onglet Sommaire, je souhaite qu'une nouvelle feuille basée sur "MODELE" se crée et que dans la zone H10, France soit inscrit. Et pareil pour le bouton Espagne ou Italie.

En vous remerciant de votre aide

@+

Sebastien
 

Pièces jointes

  • FICHE TEST.xlsm
    24.2 KB · Affichages: 13

vgendron

XLDnaute Barbatruc
avec le controle

VB:
Sub CreerFiche()
'MsgBox Application.Caller
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = Application.Caller Then
        MsgBox ("la fiche existe déjà")
        Exit Sub
    End If
Next ws
Sheets("MODELE").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Application.Caller
ActiveSheet.Range("H10") = Application.Caller

End Sub
 

kaisermpt

XLDnaute Occasionnel
Merci pour ta réponse.
Cependant mon fichier de travail est plus complexe, et le nom de l'onglet crée sera le numéro en D8 et le code (ex : 1_FRANCE puis 2_Espagne).
Du coup, je ne pense pas que je puisse reproduire ton code dans mon fichier.
L'idée c'est d'utiliser les noms en colonne B de l'onglet "REFERENCE"

merci.

Sébastien
 

vgendron

XLDnaute Barbatruc
regarde ce code avec commentaires

je pense que tu dois pouvoir modifier pour adapter à ton besoin
VB:
Sub CreerFiche()
Dim bouton As Shape
Set bouton = ActiveSheet.Shapes(Application.Caller)

'MsgBox bouton.AlternativeText 'Contenu du bouton

'MsgBox bouton.TopLeftCell.Address' Cellule qui contient le bouton
NomFeuille = Range(bouton.TopLeftCell.Address).Offset(0, -1) 'cellule à gauche du bouton == Contient le nom de la feuille à créer

'vérifie si la feuille existe déjà
For Each ws In ActiveWorkbook.Sheets
    If UCase(ws.Name) = UCase(NomFeuille) Then
        MsgBox ("la fiche existe déjà")
        Exit Sub
    End If
Next ws

Sheets("MODELE").Copy after:=Sheets(Sheets.Count) 'on copie le modèle
ActiveSheet.Name = NomFeuille 'on lui donne le nom
ActiveSheet.Range("H10") = NomFeuille 'et on met le nom en H10 de la nouvelle feuille

End Sub
 

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 870
dernier inscrit
Dethomas