Aide insertion plusieurs lignes en fonction de plusieurs critères

Le 09/03/2020 à 14:55

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

8copie-de-classeurajour.xlsm (185.08 Ko)
Le 09/03/2020 à 16:30

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+

Le 09/03/2020 à 16:42
Patty5046 a écrit :

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.

Le 09/03/2020 à 19:22

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 +

Le 09/03/2020 à 19:36

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

Le 10/03/2020 à 09:47
Patty5046 a écrit :

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

Le 10/03/2020 à 11:09

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 +

Le 10/03/2020 à 11:27
Patty5046 a écrit :

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

Le 11/03/2020 à 09:33
Patty5046 a écrit :

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

6copie-de-classeurajour.xlsm (193.57 Ko)
4doc1.docx (223.76 Ko)
4doc2.docx (111.49 Ko)
Le 11/03/2020 à 11:51

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

16classeurajour-v2.xlsm (168.23 Ko)

Bon courage

Rechercher des sujets similaires à "aide insertion lignes fonction criteres"