Aide insertion plusieurs lignes en fonction de plusieurs critères
Bonjour,
J'ai vraiment besoin de votre aide je suis complétement bloqué sur mon tableur Excel.
Je souhaite pouvoir intégrer dans ma feuille InfosSTOCK les références que j'ai renseigné dans ma feuille Validation. Jusqu'ici c'est pas compliqué! Mais j'ai parfois plusieurs références au même emplacement et j'aimerai donc en fonction du nombre de références à mon emplacement intégrer plusieurs lignes dans ma feuille InfosSTOCK en fonction de mon emplacement.
Donc si j'ai 3 références à intégrer à mon emplacement A-0-1, que soit ajouter a cette emplacement dans ma feuille InfosSTOCK 2 lignes (pour en avoir 3 en tout) et donc pouvoir copier les données renseigner dans ma feuille Validation.
Je sais pas si c'est clair, surement pas mais j'ai vraiment besoin de votre aide je sature
Bonjour Robin1963
Remplace déjà ta macro lancementA par cela....
Sub LancementA()
'
' LancementA Macro
'
'
'PARTIE 1 : UNE REFERENCE
Application.ScreenUpdating = False
Dim nbNonVide As Byte
nbNonVide = Application.WorksheetFunction.CountA(Worksheets("Validation").Range("D4"))
If nbNonVide = 0 Then
MsgBox "Merci de renseigner un emplacement"
ElseIf nbNonVide = 1 Then
If Worksheets("Validation").Range("D4") <> "" Then
Set recherche = Worksheets("InfosSTOCK").Range("B3:B10000").Find(What:=Worksheets("Validation").Range("D4").Value, LookAt:=xlWhole)
Range("D8").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("J" & recherche.Row & ":J" & recherche.Row)
Range("D12").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("I" & recherche.Row & ":I" & recherche.Row)
Range("D16").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("C" & recherche.Row & ":C" & recherche.Row)
Range("D20").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("D" & recherche.Row & ":D" & recherche.Row)
Range("D24").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("E" & recherche.Row & ":E" & recherche.Row)
Range("D28").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("F" & recherche.Row & ":F" & recherche.Row)
Range("D32").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("G" & recherche.Row & ":G" & recherche.Row)
Range("D36").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("H" & recherche.Row & ":H" & recherche.Row)
ElseIf Worksheets("Validation").Range("D4") <> "" Then
Worksheets("Validation").Range("D4").Select
End If
End If
Application.ScreenUpdating = True
End Sub
Cela sera plus clair
Ensuite, as-tu des champs obligatoires pour savoir si une ligne de ton emplacement est déjà chargée partiellement, afin de créer une autre ligne ou faut-il tester tous les champs pour savoir si l'on doit créer cette autre ligne...???
Merci
A+
Bonjour Robin1963
Remplace déjà ta macro lancementA par cela....
Sub LancementA() ' ' LancementA Macro ' ' 'PARTIE 1 : UNE REFERENCE Application.ScreenUpdating = False Dim nbNonVide As Byte nbNonVide = Application.WorksheetFunction.CountA(Worksheets("Validation").Range("D4")) If nbNonVide = 0 Then MsgBox "Merci de renseigner un emplacement" ElseIf nbNonVide = 1 Then If Worksheets("Validation").Range("D4") <> "" Then Set recherche = Worksheets("InfosSTOCK").Range("B3:B10000").Find(What:=Worksheets("Validation").Range("D4").Value, LookAt:=xlWhole) Range("D8").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("J" & recherche.Row & ":J" & recherche.Row) Range("D12").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("I" & recherche.Row & ":I" & recherche.Row) Range("D16").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("C" & recherche.Row & ":C" & recherche.Row) Range("D20").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("D" & recherche.Row & ":D" & recherche.Row) Range("D24").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("E" & recherche.Row & ":E" & recherche.Row) Range("D28").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("F" & recherche.Row & ":F" & recherche.Row) Range("D32").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("G" & recherche.Row & ":G" & recherche.Row) Range("D36").Copy ThisWorkbook.Worksheets("InfosSTOCK").Range("H" & recherche.Row & ":H" & recherche.Row) ElseIf Worksheets("Validation").Range("D4") <> "" Then Worksheets("Validation").Range("D4").Select End If End If Application.ScreenUpdating = True End Sub
Cela sera plus clair
Ensuite, as-tu des champs obligatoires pour savoir si une ligne de ton emplacement est déjà chargée partiellement, afin de créer une autre ligne ou faut-il tester tous les champs pour savoir si l'on doit créer cette autre ligne...???
Merci
A+
Merci pour ta réponse Patty, j'avais crée la macro lancement mais j'ai pas réussi à faire la suite c'est pour ca qu'elle est incomplète mais c'est beaucoup plus clair comme tu fais oui...
J'ai pas de champ obligatoire, j'ai juste fait une petite fonction SI pour afficher dans le choix de l'emplacement juste les emplacements avec les cellules vides. Donc si je sélectionne un emplacement c'est qu'il est dispo et je peux ajouter d'autres lignes si j'ai plusieurs ref à entrer.
Re
Ai corrigé certaines choses qui ne me convenaient pas dans ce que j'avais fait
Mais je suis perplexe, je n'arrive pas à voir comment tu charges ta liste emplacement dans la feuille Validation, car je constate qu'un emplacement disparaît de cette liste à chaque fois que dans InfosSTOCK la colonne C est renseignée, si on supprime la valeur dans cette colonne cela revient dans cette liste...???
Je te renverrai le fichier dès que j'aurai résolu ce mystère
A +
Je te renvoie tout de même la macro ...en attendant de comprendre le reste
Sub LancementA()
'
'PARTIE 1 : UNE REFERENCE
'
Dim nbNonVide As Byte
Dim Ligne As Long
Dim sh As Worksheet
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets("InfosSTOCK")
nbNonVide = Application.WorksheetFunction.CountA(Worksheets("Validation").Range("D4"))
If nbNonVide = 0 Then
MsgBox "Merci de renseigner un emplacement"
ElseIf nbNonVide = 1 Then
If Worksheets("Validation").Range("D4") <> "" Then
Set recherche = Worksheets("InfosSTOCK").Range("B3:B10000").Find(What:=Worksheets("Validation").Range("D4").Value, LookAt:=xlWhole)
Ligne = recherche.Row
For ind = 3 To 10
If sh.Cells(Ligne, ind) <> "" Then
sh.Rows(Ligne).Insert
sh.Cells(Ligne + 1, "K").Copy sh.Cells(Ligne, "K")
sh.Cells(Ligne + 1, "B").Copy sh.Cells(Ligne, "B")
sh.Cells(Ligne + 1, "B").Borders(xlEdgeLeft).LineStyle = xlContinuous
sh.Cells(Ligne + 1, "B").Borders(xlEdgeLeft).Weight = xlMedium
sh.Cells(Ligne + 1, "B").Borders(xlEdgeRight).LineStyle = xlContinuous
sh.Cells(Ligne + 1, "B").Borders(xlEdgeRight).Weight = xlMedium
Exit For
End If
Next
Range("D8").Copy
sh.Range("J" & Ligne & ":J" & Ligne).PasteSpecial xlPasteValues
Range("D12").Copy
sh.Range("I" & Ligne & ":I" & Ligne).PasteSpecial xlPasteValues
Range("D16").Copy
sh.Range("C" & Ligne & ":C" & Ligne).PasteSpecial xlPasteValues
Range("D20").Copy
sh.Range("D" & Ligne & ":D" & Ligne).PasteSpecial xlPasteValues
Range("D24").Copy
sh.Range("E" & Ligne & ":E" & Ligne).PasteSpecial xlPasteValues
Range("D28").Copy
sh.Range("F" & Ligne & ":F" & Ligne).PasteSpecial xlPasteValues
Range("D32").Copy
sh.Range("G" & Ligne & ":G" & Ligne).PasteSpecial xlPasteValues
Range("D36").Copy
sh.Range("H" & Ligne & ":H" & Ligne).PasteSpecial xlPasteValues
ElseIf Worksheets("Validation").Range("D4") <> "" Then
Worksheets("Validation").Range("D4").Select
End If
End If
Application.ScreenUpdating = True
End Sub
Bon courage et bonne soirée
Re
Ai corrigé certaines choses qui ne me convenaient pas dans ce que j'avais fait
Mais je suis perplexe, je n'arrive pas à voir comment tu charges ta liste emplacement dans la feuille Validation, car je constate qu'un emplacement disparaît de cette liste à chaque fois que dans InfosSTOCK la colonne C est renseignée, si on supprime la valeur dans cette colonne cela revient dans cette liste...???
Je te renverrai le fichier dès que j'aurai résolu ce mystère
A +
Oui, mais je vais verrouiller la feuille InfosSTOCK pour ne pouvoir supprimer une référence que par la feuille 'Sortie de stock'.
En faite mon problème c'est pas copier juste les données de 'Validation' à 'InfosSTOCK' mais de mettre en forme ma feuille infosSTOCK si j'ai choisis d'entrée plusieurs références et d'entrée les références en fonction. Si j'ai deux références pour un emplacement, entrer une ligne à l'emplacement défini puis copier les deux références sur les deux lignes de l'emplacement.
Pour le nombre de référence choisis j'ai fait une macro dans la feuille 'Validation' si je choisis dans l'emplacement 'D6' 3 références et que je valide juste à droite, l'ensemble de la feuille 'Validation' s'adapte en ajoutant 2 lignes à chaque titre, j'ai une macro remise a zéro sur la même feuille pour revenir au départ.
Tu peux essayer pour y voir plus clair, c'est difficile d'être explicite.
Merci pour ton temps en tous cas c'est vraiment sympa de m'aider
Bonjour
Si tu rentres plusieurs fois le même emplacement, ma macro te rajoute des lignes.. regarde bien
N'aurai pas beaucoup de temps pendant 2 jours..
A +
Bonjour
Si tu rentres plusieurs fois le même emplacement, ma macro te rajoute des lignes.. regarde bien
N'aurai pas beaucoup de temps pendant 2 jours..
A +
Ah oui j'avais pas capté ! C'est ce que je recherche, faut juste que je l'adapte un peu pour qu'il me prenne plusieurs lignes de données de ma feuille 'Validation' à la fois. Je vais try hard, merci pour ton aide
Bonjour
Si tu rentres plusieurs fois le même emplacement, ma macro te rajoute des lignes.. regarde bien
N'aurai pas beaucoup de temps pendant 2 jours..
A +
Salut ! J'ai adapté ta macro à mes besoins mais le problème qui se pose c'est que l'ajout des lignes se fait au dessus de l'emplacement et par rapport à la ligne du dessus, donc si je veux insérer deux références à l'emplacement A-0-1 l'insertion se fait avec la mise en forme de mes titres et au dessus de la ligne d'insertion. Je voudrai l'insérer en dessous de ma ligne emplacement c'est possible ? Je te joins mon fichier avec l'exemple de mon explication.
Dans le doc 1 comme c'est maintenant
Dans le doc 2 comme je voudrai que la ligne s'ajoute
Bonjour Robin1963,
J'ai retiré la macro LanceMACRO du bouton "Entrée en stock" et mis à la place LancementA, que j'ai modifié pour inclure ce qu'il y avait dans la première.
Puis j'ai corrigé cette macro LancementA pour aussi ajouté les lignes après et non avant
Bon courage