Création automatique de feuilles en fonction de la valeur d'une cellule

lucas68

XLDnaute Nouveau
Bonjour,

Mon problème peut paraître compliqué en lisant le titre, mais je pense qu'il me faut juste un coup de pouce. ça doit pas être bien sorcier.

J'ai une base de données renseignée à la main, et j'aimerais créer des feuilles dans mon classeur en fonction des données.
J'ai créé un fichier exemple qui permettra d'illustrer mes propos:

Il y a 3 types de modèles, et 3 feuilles ''masques''. Le but de l'opération serait de copier la feuille masque correspondant au modèle de la ligne et de la renommer selon le nom du modèle.

J'ai donc "tenté" de créer une macro private sub qui lancera la copie de la feuille lorsqu'on écrit "ok" en fin de ligne. Mais ça marche pas. :mad::mad::mad:

Je ne comprends pas pourquoi. Est ce que quelqu'un peut m'éclairer ?

Merci d'avance !

Lucas
 

Pièces jointes

  • exemple modèle Lucas.xls
    34 KB · Affichages: 38
  • exemple modèle Lucas.xls
    34 KB · Affichages: 45
  • exemple modèle Lucas.xls
    34 KB · Affichages: 44

Abel

XLDnaute Accro
Re : Création automatique de feuilles en fonction de la valeur d'une cellule

Bonjour lucas68,

Essaie ce code à placer dans "Feuil1" de ton exemple.
Fonctionne quand on fait un double clic en colonne "F" de la "Feuil1".

Merci à job75.

Code:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Application.Intersect(Target, Range("f2:f" & [a65536].End(xlUp).Row)) Is Nothing Then Exit Sub
Dim Masque As String
Dim NouvelleFeuille As String, BaseDonnees As String

Cancel = True
Target = IIf(UCase(Target) = "OK", "", "OK")
Application.ScreenUpdating = False
If Target = "OK" Then
Masque = "Masque Type " & Cells(Target.Row, 5)
NouvelleFeuille = Cells(Target.Row, 1)
Sheets(Masque).Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = NouvelleFeuille
Worksheets("Feuil1").Select
With Worksheets(NouvelleFeuille)
    .[b2] = Cells(Target.Row, 1)
    .[b3] = Cells(Target.Row, 2)
    .[b4] = Cells(Target.Row, 3)
    .[b5] = Cells(Target.Row, 4)
End With
End If
Application.ScreenUpdating = True
End Sub


Abel.
 

Discussions similaires

Statistiques des forums

Discussions
312 248
Messages
2 086 594
Membres
103 250
dernier inscrit
keks974