recopier une donnée en fonction d'une valeur

filierfilier

XLDnaute Junior
Bonjour,
je voudrai recopier en même temps, mais qu'une partie de donnée dans une autre feuille que celle de la destination de mon UserForm.
Explication
Dans un classeur Achats:
J'ai une Feuille recette ou je peux insérer des données avec le bouton " Créer une nouvelle recette "
J'ai une Feuille Liste des plats : Triées par nature de plat (7 au total)
Si je crée la recette Yabon (Nom_de_la_recette) en lui affectant comme nature : dessert (NatureControls) à partir de mon formulaire (voir ci joint)
Je voudrai que seulement la donnée Yabon se mette aussi dans la feuille Listes des plats mais à la suite du dernier enregistrement dans la colonne Dessert (qui elle même est une liste pour créer les menus) et ainsi de suite pour les autres recettes si cela est un plat ou une entrée ou un légumes etc ...

Voir fichier joint
Code pour l'insertion et création de fiche
Private Sub B_valider_Click()

'--- Contrôles ingredient et quantite 1
If Me.Ingredient_1 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 1!"
Me.Ingredient_1.SetFocus
Exit Sub
End If
If Me.Quantite_1 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 1!"
Me.Quantite_1.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 2
If Me.Ingredient_2 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 2!"
Me.Ingredient_2.SetFocus
Exit Sub
End If
If Me.Quantite_2 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 2!"
Me.Quantite_2.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 3
If Me.Ingredient_3 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 3!"
Me.Ingredient_3.SetFocus
Exit Sub
End If
If Me.Quantite_3 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 3!"
Me.Quantite_3.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 4
If Me.Ingredient_4 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 4!"
Me.Ingredient_4.SetFocus
Exit Sub
End If
If Me.Quantite_4 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 4!"
Me.Quantite_4.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 5
If Me.Ingredient_5 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 5!"
Me.Ingredient_5.SetFocus
Exit Sub
End If
If Me.Quantite_5 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 5!"
Me.Quantite_5.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 6
If Me.Ingredient_6 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 6!"
Me.Ingredient_6.SetFocus
Exit Sub
End If
If Me.Quantite_6 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 6!"
Me.Quantite_6.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 7
If Me.Ingredient_7 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 7!"
Me.Ingredient_7.SetFocus
Exit Sub
End If
If Me.Quantite_7 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 7!"
Me.Quantite_7.SetFocus
Exit Sub
End If
'--- Contrôles ingredient et quantite 8
If Me.Ingredient_8 = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient 8!"
Me.Ingredient_8.SetFocus
Exit Sub
End If
If Me.Quantite_8 = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient 8!"
Me.Quantite_8.SetFocus
Exit Sub
End If

'--- Positionnement dans la base
[A65000].End(xlUp).Offset(1, 0).Select
'--- Transfert Formulaire dans BD

ActiveCell.Offset(0, 1).Value = Me.Nom_de_la_recette
ActiveCell.Offset(0, 2).Value = Me.Ingredient_1
ActiveCell.Offset(0, 3).Value = Me.Quantite_1
ActiveCell.Offset(0, 4).Value = Me.Ingredient_2
ActiveCell.Offset(0, 5).Value = Me.Quantite_2
ActiveCell.Offset(0, 6).Value = Me.Ingredient_3
ActiveCell.Offset(0, 7).Value = Me.Quantite_3
ActiveCell.Offset(0, 8).Value = Me.Ingredient_4
ActiveCell.Offset(0, 9).Value = Me.Quantite_4
ActiveCell.Offset(0, 10).Value = Me.Ingredient_5
ActiveCell.Offset(0, 11).Value = Me.Quantite_5
ActiveCell.Offset(0, 12).Value = Me.Ingredient_6
ActiveCell.Offset(0, 13).Value = Me.Quantite_6
ActiveCell.Offset(0, 14).Value = Me.Ingredient_7
ActiveCell.Offset(0, 15).Value = Me.Quantite_7
ActiveCell.Offset(0, 16).Value = Me.Ingredient_8
ActiveCell.Offset(0, 17).Value = Me.Quantite_8
'-- Civilité
temp = ""
For Each c In Me.Nature.Controls
If c.Value = True Then
temp = c.Caption
End If
Next c
ActiveCell.Value = temp
'--
nettoie
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : recopier une donnée en fonction d'une valeur

Bonjour filierfilier


Peux-tu stp utiliser la balise BBCODE CODE (ou en cliquant sur cet icone
code.gif
)
pour rendre ton message plus lisible

Tu sélectionnes le code VBA présent dans ton message et tu cliques sur :
code.gif


Merci d'avance (pour nos yeux)

PS: tu peux utiliser aussi la balise que je cite dans ma signature.

EDITION: Re, BrunoM45
 
Dernière édition:
C

Compte Supprimé 979

Guest
Re : recopier une donnée en fonction d'une valeur

Salut Filier²

Juste pour ton info personnelle, tu peux largement optimiser ton code
Sinon ce code doit faire l'affaire ;-)
VB:
Private Sub UserForm_Initialize()
Me.Nature.Controls(0) = "Entrée"
Me.Nature.Controls(1) = "Plat"
Me.Nature.Controls(2) = "Légume"
Me.Nature.Controls(3) = "Fromage-Salade"
Me.Nature.Controls(4) = "Dessert"
Me.Nature.Controls(5) = "Extra"
For I = 1 To 8
Me("Ingredient_" & I).RowSource = "nomproduits"
Me("Quantite_" & I).RowSource = "poidsproduits"
Next I
End Sub
Private Sub B_valider_Click()
Dim I As Integer, DLig As Long
For I = 1 To 8
'--- Contrôles ingredient et quantite
If Me("Ingredient_" & I) = "" Then
MsgBox "Veuillez saisir le nom de l'ingrédient " & I & " !"
Me("Ingredient_" & I).SetFocus
Exit Sub
End If
If Me("Quantite_" & I) = "" Then
MsgBox "Veuillez saisir le poids de l'ingrédient " & I & " !"
Me("Quantite_" & I).SetFocus
Exit Sub
End If
Next I
'--- Positionnement dans la base
With Sheets("Recettes")
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
'--- Transfert Formulaire dans BD
ActiveCell.Offset(0, 1).Value = Me.Nom_de_la_recette
For I = 2 To 16 Step 2
ActiveCell.Offset(0, I).Value = Me("Ingredient_" & I / 2)
ActiveCell.Offset(0, 1 + I).Value = Me("Quantite_" & I / 2)
Next I
' Choix de la recette
For I = 1 To 6
If Me("OptionButton" & I) = True Then
ActiveCell.Value = Me("OptionButton" & I).Caption
' Inscrire le nom de la recette dans la listes des plats
' En partant du principe que les OptionButton sont dans le mêmes sens que sur la feuille : Liste des plats
With Sheets("Liste des Plats")
' Trouver la dernière ligne de la colonne concernée
DLig = .Cells(Rows.Count, I).End(xlUp).Row + 1
.Cells(DLig, I).Value = Me.Nom_de_la_recette

End With
' Sortir de la boucle
Exit For
End If
Next I
End With
Call Nettoie
End Sub

A+
 
Dernière modification par un modérateur:

filierfilier

XLDnaute Junior
Re : recopier une donnée en fonction d'une valeur

Bonjour
Merci pour cette aide sur cette macro.
Bon, l'idée est super dans ma demande, mais c'est le nom de la recette que je veux mettre dans la feuille liste des plats. Or là, c'est la nature de l'OptionButton qui y est inséré. D'autre part la fonction Call Nettoie me renvoie une erreur. A voir si !
De toute façon merci encore de votre sollicitude à mon égard.
 

filierfilier

XLDnaute Junior
Re : recopier une donnée en fonction d'une valeur

Bonjour !
Merci BrunoM45
J'ai vu l'erreur sur ma feuille.
Cela marche très bien ,pas de soucis !
Merci encore pour votre dévouement.
Je pense mettre en ligne l'application une fois terminée. Cela pourra certainement servir à d'autres !
Bonne continuation, bye !
 

filierfilier

XLDnaute Junior
Re : recopier une donnée en fonction d'une valeur

Re- bonjour !
est il possible de faire une opération avec une TextBox ou autre, (de division par exemple pour noter les recettes selon un critère de nombres convives dans une recette /2 ou / 4 ou etc ...) sur les Me.Quantite de mon code.
Ceci afin d'évitez de diviser en notant les recettes par personne