Générer des fiches en fonction d'une fiches modèle

Bonjour tout le monde.

J'ai longtemps hésité avant de m'adresser à vous, mais mes recherches demeurant infructueuses, je me lance.

Je remercie d’avance toutes les personnes qui prendrons le temps lire mon post et qui peut-être pourrons me proposer une solution.

Le contexte :

J’ai une feuille principale (feuille 1) où je fais une liste des produits chimiques avec leurs fonctions.

J’ai une feuille modèle (feuille 2 ) qui me permet de rentrer les mentions de danger de ces produits.

Ce que j’ai déjà :

  • Sur la feuille 1 j’entre ma liste de produits, par exemple 5 produits
  • Je clique sur un bouton « générer fiches produits »
  • Une nouvelle feuille se crée pour chacun des 5 produits
  • Chaque feuille porte le nom du produit associé
  • Pour chaque nouvelle feuille crée, un lien hypertexte se créer sur la feuille 1 en face du produit correspondant

Tout ça fonctionne plutôt bien sauf que…

Le problème :

Je crée mes 5 fiches produits, tout va très bien, mais cela ne fonctionne plus lorsque je rajoute un sixième produits.

Quand je clique une nouvelle fois pour générer la fiche de mon sixième produit, mon « programme » repars du tout premier produit.

La solution que je n’arrive pas à mettre en œuvre :

Lorsque que je clique sur générer fiche produit, je voudrais que ça commence après le dernier ajout.

Par exemple en vérifiant un à un, si les produits de la feuille 1 correspondent déjà à une fiche produit associé pour ensuite générer une fiche produit pour ceux qui n’en non pas.

Si vous pensez à autres choses, je suis preneur.

Voici le code dont je me sert :

Sub Creation_Onglets_Selon_Modele()
    Dim c As Range

    Application.ScreenUpdating = False
    'On crée les onglets qui sont listés à partir de la cellule
    'A2 de l'onglet nommé Liste
    Set c = Worksheets("Fiche principale").Range("B3") 'cellule de départ
    Do Until IsEmpty(c)     'boucle tant que c est vide

        'on copie le modèle en dernier
        Worksheets("Tableau d'analyse CMR").Copy After:=Worksheets(ThisWorkbook.Sheets.Count)

        With Worksheets(ThisWorkbook.Sheets.Count) 'avec l'onglet créé
            .Name = c.Value     'on renomme
            'on remplit notre modèle comme on veut...
            .Range("C1") = c.Value
            .Range("C3") = Date
        End With

        Set c = c.Offset(1, 0)      'prochaine ligne
    Loop

    Application.ScreenUpdating = True
End Sub

Pour respecter le travail des autres, je précise tout de même que le code n'est pas de moi et mise à part deux trois lignes je ne comprend pas grand chose à tout cela (en attente de plus de temps pour me former convenablement au VBA)

Je renouvelle mes remerciements à toutes personnes ayant lu mon commentaire jusque ici

Cordialement Funka

161internet.xlsm (211.54 Ko)

Bonjour et bienvenue sur le forum

Il serait plus facile d'essayer de t'aider si tu joignais ton fichier complet, même anoymisé...

Bye !

Merci Gmb,

Voilà j'ai ajouté le fichier.

(ultra simplifié/ alléger~ 300ko max)

En effet, ton fichier est super allégé : 0k !

Tu devrais passer par www.cjoint.com

Bye !

Ok, merci pour le lien, mais...

Le problème c'est que je ne peux pas publier d'avantage (travail)

Mais normalement c'est bon, la partie de code que je recherche ne concerne que ces deux feuilles.

Funka a écrit :

Le problème c'est que je ne peux pas publier d'avantage (travail)

Alors, si tu ne peux publier qu'un fichier de 0k (zéro k) c'est à dire pas de fichier du tout , je ne peux pas t'aider.

Désolé !

Bye !

Bonjour,

J'ai jeté un oeil à ton fichier mais je semble pas pouvoir reproduir ton problème:

- si j'ai 6 produits et que je clique -> ça me créé 6 fiches

  • si j'ai 4 produits et que je clique -> ça me créé 4 fiches
  • si ensuite j'ajoute un 5ème produit et que je clique -> j'obtiens une erreur

J'ai peut-être mal compris ton problème sinon?

Ze

ze6killer a écrit :

Bonjour,

  • si j'ai 4 produits et que je clique -> ça me créé 4 fiches
  • si ensuite j'ajoute un 5ème produit et que je clique -> j'obtiens une erreur

Ze

Mon problème se situe exactement la, c'est à dire quand j'ajoute un produit supplémentaire.

Si j'en créer 5, 10, 25, 40 en même temps ça marche, mais si je veux en rajouter un après les avoir créer -> j'obtiens un message d'erreur

gmb a écrit :
Funka a écrit :

Le problème c'est que je ne peux pas publier d'avantage (travail)

Alors, si tu ne peux publier qu'un fichier de 0k (zéro k) c'est à dire pas de fichier du tout , je ne peux pas t'aider.

Désolé !

Bye !

tu fais bien de le préciser, j'avais compris OK au lieu de zéro K.

Je vois ce que tu veux dire, mais c'est bizarre le fichier fait 211.54K

Pourquoi ne pas comparer les noms des produits que tu essaies de créer aux noms des onglets déjà existants et retirer de ta boucle ceux qui existent déjà?

Car c'est de là que vient l'erreur si j'ai bien compris: excel râle car tu tentes d'avoir deux onglets avec le même nom.

Ze

ze6killer a écrit :

Pourquoi ne pas comparer les noms des produits que tu essaies de créer aux noms des onglets déjà existants et retirer de ta boucle ceux qui existent déjà?

Car c'est de là que vient l'erreur si j'ai bien compris: excel râle car tu tentes d'avoir deux onglets avec le même nom.

Ze

C'est exactement ce que je souhaiterais faire, mais mes compétences en codage sont...assez limité

Un ami a réussi à me trouver quelque chose, qui fonctionne pas trop mal.

Je vous en fait part pour toutes les personnes qui ont cherchés à me fournir une solution.

Merci.

Sub create_list_tab()
Dim name As Range
Dim name_exist As Integer
Application.ScreenUpdating = False
Set name = Worksheets("Fiche principale").Range("B3")
On Error Resume Next
Do Until IsEmpty(name)
  Err = 0
  Worksheets("Tableau d'analyse CMR").Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
  With Worksheets(ThisWorkbook.Sheets.Count)
  .name = name.Value
  .Range("C1") = name.Value
  .Range("C3") = Date
  End With
If Err <> 0 Then
  Application.DisplayAlerts = False
  ActiveSheet.Delete
  Application.DisplayAlerts = True
End If
Set name = name.Offset(1, 0)
Loop
Application.ScreenUpdating = True
End Sub
Rechercher des sujets similaires à "generer fiches fonction modele"