Insérer une ligne en fonction d'un résultat (feuilles différentes)

Hello à tous,

Je bosse sur un sujet d'amélioration continue pour un fichier Excel dans l'entreprise où je suis et il me manque une dernière chose à faire pour avoir un fichier top mais mes connaissances Excel ne sont pas encore assez avancées.

Pour résumer, ce que je cherche à faire :

Insérer une ligne en Feuille2 selon un résultat qui s'affiche dans une cellule présente en Feuille1.

Exemple :

Dans la colonne "Plastique", si le résultat est "3", insérer 3 lignes en Feuille2 en mentionnant sur des cellules spécifiques le nom de la colonne à chaque ligne.

J'ai ajouté en PJ une simulation proche de mon fichier réel.

Je souhaite donc automatiser ce qui est écrit en rouge. Sur la Feuille1 tout sera écrit manuellement, et je souhaite faire réapparaître ces infos en Feuille2 avec le nombre de lignes qui correspond aux chiffres dans les colonnes de la Feuille1.

Si le fait de récupérer les données écrites en Feuille1 n'est pas possible pas grave, on pourra les réécrire manuellement. Le plus important étant l'insertion des lignes selon la catégorie.

Quelqu'un pense pouvoir m'aider ?

Merci beaucoup !!!

29testvba.xlsx (12.62 Ko)

Bonjour MThev, et bienvenue,

voici un exemple à copier sur la page code de l'onglet "RECAP

l'action s'exécute lorsque la valeur sur la colonne "I" de cette feuille change

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, lastRw As Long, i As Integer

If Not Application.Intersect(Target, Columns("I")) Is Nothing Then

    For Each c In Range("G" & Target.Row & ":I" & Target.Row)

        For i = 1 To c.Value
            lastRw = Sheets("DETAIL").Cells(Rows.Count, "B").End(xlUp).Row + 1

            Sheets("DETAIL").Cells(lastRw, "B") = Cells(c.Row, "B").Value
            Sheets("DETAIL").Cells(lastRw, "C") = Cells(c.Row, "C").Value
            Sheets("DETAIL").Cells(lastRw, "D") = Cells(c.Row, "D").Value
            Sheets("DETAIL").Cells(lastRw, "E") = Cells(c.Row, "E").Value
            Sheets("DETAIL").Cells(lastRw, "F") = Cells(c.Row, "F")
            Sheets("DETAIL").Cells(lastRw, "G") = Year(Cells(c.Row, "F"))
            Sheets("DETAIL").Cells(lastRw, "H") = Cells(3, c.Column).Value
        Next i
    Next c
End If
End Sub

Bonjour i20100,

Déjà, merci beaucoup pour ton message de bienvenu et pour ta réponse !! Une bonne partie est résolue !

Sur le fichier test que j'ai envoyé, c'est OK.

Toutefois, j'ai fait quelques modifications de mon vrai fichier. J'ai donc tenté d'adapter le code au nouveau fichier. Tout fonctionne (ça ajoute le nombre de lignes + copies les cellules qui m'intéressent) mais ça ne copie plus les matériaux qui correspond aux chiffres des colonnes de la Feuille1.

Je sais bien que l'erreur vient forcément de moi, mais je n'arrive pas à la détecter.

Donc en gros, pour résumer :

Quand j'écris dans les colonnes "Verres = 3" ; "Métal = 4" ; "Etuis = 1" ; ça va bien m'insérer les 8 lignes avec les cellules copiées mais ça ne va pas copier 3xVerre + 4xMétal + 1xEtui.

Voici le code que j'ai modifié :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, lastRw As Long, i As Integer

If Not Application.Intersect(Target, Columns("K")) Is Nothing Then

    For Each c In Range("I" & Target.Row & ":K" & Target.Row)

        For i = 1 To c.Value
            lastRw = Sheets("BUYING TRACK").Cells(Rows.Count, "B").End(xlUp).Row + 1

            Sheets("BUYING TRACK").Cells(lastRw, "B") = Cells(c.Row, "D").Value
            Sheets("BUYING TRACK").Cells(lastRw, "C") = Cells(c.Row, "B").Value
            Sheets("BUYING TRACK").Cells(lastRw, "D") = Cells(c.Row, "H").Value
            Sheets("BUYING TRACK").Cells(lastRw, "E") = Cells(c.Row, "E").Value
            Sheets("BUYING TRACK").Cells(lastRw, "F") = Cells(c.Row, "C")
            Sheets("BUYING TRACK").Cells(lastRw, "G") = Cells(3, c.Column).Value
        Next i
    Next c
End If
End Sub

Est-ce que t'arrives à voir la faute rien qu'avec le code ?

Merci beaucoup !!

re,

sans voir le fichier c'est difficile de trouver l'erreur

Hello,

Non en fait c'est bon j'ai trouvé !

C'était tout simple... j'avais simplement inséré des lignes en haut de ma Feuille1, du coup les noms des colonnes à copier n'étaient plus en ligne 3 mais en ligne 5 !

Dernière question (là c'est du bonus juste histoire de peaufiner) :

Dans l'exemple que j'ai envoyé dans mon message initial, tu vois en rouge ce que je souhaitais faire dans la feuille Feuille2.

Or, il y a une ligne récap qui comprend les valeurs des colonnes B à E puis les colonnes d'après sont vides. J'aurais d'ailleurs souhaité que cette ligne soit en gras si possible.

Puis les lignes d'en dessous s'ajoutent selon les valeurs des colonnes "Verre" ; "Métal"; "Etuis" en Feuille1. Et sur ces nouvelles lignes il y a : la valeur de la colonne B, C, D + en colonne H les matériaux en fonction des résultats en Feuille1.

Donc si je ne dis pas de betises, si je reprends ton code, j'ai juste à enlever les colonnes que je ne souhaite pas faire afficher dans les nouvelles lignes, ça OK, mais pour ma ligne récap je ne sais pas trop comment faire ?

Il faudrait en gros, si je ne dis pas de bêtises, dire qu'en fonction du résultat des 3 colonnes en Feuille1, ajouter une ligne en plus à chaque fois et que cette première ligne soit en gras avec les valeurs des colonnes B à E.

Est-ce que tu vois où je veux en venir ?

Merci !!

re,

j'ai fais quelque modification, dit-moi si c'est ok ?

24mthev-testvba.xlsm (21.32 Ko)

re,

j'ai fais quelque modification, dit-moi si c'est ok ?

MThev-TestVBA.xlsm

C'est parfait !! Merci beaucoup !!

Hello !

Je me suis rendu compte que les utilisateurs du fichier me remontaient tous le même "problème".

Dans le code ci-dessous, on ajoute le nombre de lignes en Feuille2 selon les résultats dans les colonnes en Feuille1.

Sauf que, si je souhaite par exemple mettre à jour une de mes lignes, ça ne marche pas : la macro va créer un nouveau bloc et insérer de nouvelles lignes.

Est-ce qu'il serait possible d'améliorer cela en faisant par exemple une sorte de rechercheV de la colonne "Code" et si ce code existe, mettre à jour le nombre de lignes au lieu d'en ajouter des nouvelles à chaque fois ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, lastRw As Long, i As Integer
Dim sh1 As Worksheet, sh2 As Worksheet

Set sh1 = Sheets("RECAP")
Set sh2 = Sheets("DETAIL")

With sh2

    If Not Application.Intersect(Target, Columns("I")) Is Nothing Then

        lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

        .Cells(lastRw, "B") = sh1.Cells(Target.Row, "B").Value
        .Cells(lastRw, "C") = sh1.Cells(Target.Row, "C").Value
        .Cells(lastRw, "D") = sh1.Cells(Target.Row, "D").Value
        .Cells(lastRw, "E") = sh1.Cells(Target.Row, "E").Value
        .Cells(lastRw, "F") = sh1.Cells(Target.Row, "F")
        .Cells(lastRw, "G") = Year(sh1.Cells(Target.Row, "F"))

        With sh2.Range("B" & lastRw & ":K" & lastRw)
            .Interior.Color = RGB(255, 242, 204)
            .Font.Bold = True
        End With

        For Each c In sh1.Range("G" & Target.Row & ":I" & Target.Row)
            For i = 1 To c.Value
                lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

                .Cells(lastRw, "B") = sh1.Cells(c.Row, "B").Value
                .Cells(lastRw, "C") = sh1.Cells(c.Row, "C").Value
                .Cells(lastRw, "D") = sh1.Cells(c.Row, "D").Value
                .Cells(lastRw, "H") = sh1.Cells(3, c.Column).Value
            Next i
        Next c
    End If
End With
End Sub

Merci beaucoup !!

Hello !

Je pensais avoir trouvé une combine mais finalement le résultat n'y est pas, il se passe la même chose...

Help..!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, lastRw As Long, i As Integer
Dim sh1 As Worksheet, sh2 As Worksheet
Dim celluletrouvee As Range
Dim PlageDeRecherche As Range

Set sh1 = Sheets("PROJECT TRACK")
Set sh2 = Sheets("BUYING TRACK")
Set PlageDeRecherche = sh2.Columns("C")

recherche = sh1.Cells(Rows.Count, "B").End(xlUp).Row

Set celluletrouvee = PlageDeRecherche.Cells.Find(recherche, LookAt:=xlWhole)

If Not celluletrouvee Is Nothing Then

    With sh2

        If Not Application.Intersect(Target, Columns("K")) Is Nothing Then

            For Each c In sh1.Range("I" & Target.Row & ":K" & Target.Row)
                For i = 1 To c.Value
                    newRw = Rows(celluletrouvee.Row + 1).Insert

                    .Cells(newRw, "B") = sh1.Cells(c.Row, "D").Value
                    .Cells(newRw, "C") = sh1.Cells(c.Row, "B").Value
                    .Cells(newRw, "D") = sh1.Cells(c.Row, "H").Value
                    .Cells(newRw, "E") = sh1.Cells(c.Row, "E").Value
                    .Cells(newRw, "G") = sh1.Cells(5, c.Column).Value
                Next i
            Next c
        End If
    End With

Else

    With sh2

        If Not Application.Intersect(Target, Columns("K")) Is Nothing Then

            lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

            .Cells(lastRw, "B") = sh1.Cells(Target.Row, "D").Value
            .Cells(lastRw, "C") = sh1.Cells(Target.Row, "B").Value
            .Cells(lastRw, "D") = sh1.Cells(Target.Row, "H").Value
            .Cells(lastRw, "E") = sh1.Cells(Target.Row, "E").Value
            .Cells(lastRw, "F") = sh1.Cells(Target.Row, "C")

            With sh2.Range("B" & lastRw & ":J" & lastRw)
                .Interior.Color = RGB(221, 235, 247)
                .Font.Bold = True
            End With

            For Each c In sh1.Range("I" & Target.Row & ":K" & Target.Row)
                For i = 1 To c.Value
                    lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

                    .Cells(lastRw, "B") = sh1.Cells(c.Row, "D").Value
                    .Cells(lastRw, "C") = sh1.Cells(c.Row, "B").Value
                    .Cells(lastRw, "D") = sh1.Cells(c.Row, "H").Value
                    .Cells(lastRw, "E") = sh1.Cells(c.Row, "E").Value
                    .Cells(lastRw, "G") = sh1.Cells(5, c.Column).Value
                Next i
            Next c
        End If
    End With
End If

End Sub

Le code marche mais n'insère pas les lignes suite au résultat de ma recherche..............................

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range, lastRw As Long, newRw As Long, i As Integer
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Rng As Range, Found As Range
Dim Trouve As Range, PlagedeRecherche As Range
Dim Valeur_Cherchee As String

Set sh1 = Sheets("PROJECT TRACK")
Set sh2 = Sheets("BUYING TRACK")

    If Not IsEmpty(Target) And Target.Column = 2 Then
        Set Rng = Me.Cells(2).Resize(Target.Row - 1)
        Set Found = Rng.Find(what:=Target.Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not Found Is Nothing Then
            MsgBox "Attention ! Ce code projet existe déjà !", 64, "Information"
        End If
    End If

Valeur_Cherchee = sh1.Cells(Rows.Count, "B").End(xlUp).Row
Set PlagedeRecherche = sh2.Columns("C")
Set Trouve = PlagedeRecherche.Cells.Find(what:=Valeur_Cherchee, Lookat:=xlWhole)

With sh2

    If Not Application.Intersect(Target, Columns("K")) Is Nothing Then

        If Not Trouve Is Nothing Then

            For Each c In sh1.Range("I" & Target.Row & ":K" & Target.Row)
                For i = 1 To c.Value
                    newRw = .Rows(Trouve.Row + 1).Insert

                    .Cells(newRw, "B") = sh1.Cells(c.Row, "D").Value
                    .Cells(newRw, "C") = sh1.Cells(c.Row, "B").Value
                    .Cells(newRw, "D") = sh1.Cells(c.Row, "H").Value
                    .Cells(newRw, "E") = sh1.Cells(c.Row, "E").Value
                    .Cells(newRw, "G") = sh1.Cells(5, c.Column).Value
                Next i
            Next c
        Else

With sh2

    If Not Application.Intersect(Target, Columns("K")) Is Nothing Then

        lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

            .Cells(lastRw, "B") = sh1.Cells(Target.Row, "D").Value
            .Cells(lastRw, "C") = sh1.Cells(Target.Row, "B").Value
            .Cells(lastRw, "D") = sh1.Cells(Target.Row, "H").Value
            .Cells(lastRw, "E") = sh1.Cells(Target.Row, "E").Value
            .Cells(lastRw, "F") = sh1.Cells(Target.Row, "C")

        With sh2.Range("B" & lastRw & ":J" & lastRw)
            .Interior.Color = RGB(221, 235, 247)
            .Font.Bold = True
        End With

        For Each c In sh1.Range("I" & Target.Row & ":K" & Target.Row)
            For i = 1 To c.Value
                lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

                .Cells(lastRw, "B") = sh1.Cells(c.Row, "D").Value
                .Cells(lastRw, "C") = sh1.Cells(c.Row, "B").Value
                .Cells(lastRw, "D") = sh1.Cells(c.Row, "H").Value
                .Cells(lastRw, "E") = sh1.Cells(c.Row, "E").Value
                .Cells(lastRw, "G") = sh1.Cells(5, c.Column).Value
            Next i
        Next c
    End If
End With
End If
End If
End With

End Sub

Le code marche mais n'insère pas les lignes suite au résultat de ma recherche..............................

je n'ai pas compris la façon que cela doit fonctionner ?

Le code marche mais n'insère pas les lignes suite au résultat de ma recherche..............................

je n'ai pas compris la façon que cela doit fonctionner ?

Hello !

Alors en fait, le code que j'ai aujourd'hui me permet d'ajouter des nouvelles lignes automatiquement en reprenant certaines données de ma Feuille1 à ma Feuille2 en fonction du résultats de mes 3 dernières colonnes en Feuille1. Jusque-là ok, c'est ce qu'on avait réussi à faire !

Sauf que le problème pour mes utilisateurs, c'est qu'à chaque fois cette macro crée un nouveau bloque de lignes tout à la fin et elle ne permet pas de mettre à jour des données déjà rentrées.

Voici un exemple dans ce fichier.

J'ai mis en rouge ce que je souhaiterais faire.

Donc mon idée dans mon code c'était de dire :

A chaque fois qu'on met en Feuille1 un nouveau code, qu'il vérifie s'il existe déjà (si oui : msg box existe déjà / si non : rien).

Une fois que la colonne K est rempli, la macro vérifie si le code existe déjà en Feuille2 et s'il existe que les nouvelles lignes remplacent les existantes plutôt que d'insérer un nouveau bloc de lignes tout à la fin du tableau.

J'essaye d'être le plus clair possible.....

4mthev-testvba.xlsm (22.08 Ko)

Je me suis rendu compte que les utilisateurs du fichier me remontaient tous le même "problème".

Dans le code ci-dessous, on ajoute le nombre de lignes en Feuille2 selon les résultats dans les colonnes en Feuille1.

Sauf que, si je souhaite par exemple mettre à jour une de mes lignes, ça ne marche pas : la macro va créer un nouveau bloc et insérer de nouvelles lignes.

Est-ce qu'il serait possible d'améliorer cela en faisant par exemple une sorte de rechercheV de la colonne "Code" et si ce code existe, mettre à jour le nombre de lignes au lieu d'en ajouter des nouvelles à chaque fois ?

je ne comprend pas ce nouveau problème, peux-tu joindre un fichier et insérer les explications dans ce fichier ?

Je me suis rendu compte que les utilisateurs du fichier me remontaient tous le même "problème".

Dans le code ci-dessous, on ajoute le nombre de lignes en Feuille2 selon les résultats dans les colonnes en Feuille1.

Sauf que, si je souhaite par exemple mettre à jour une de mes lignes, ça ne marche pas : la macro va créer un nouveau bloc et insérer de nouvelles lignes.

Est-ce qu'il serait possible d'améliorer cela en faisant par exemple une sorte de rechercheV de la colonne "Code" et si ce code existe, mettre à jour le nombre de lignes au lieu d'en ajouter des nouvelles à chaque fois ?

je ne comprend pas ce nouveau problème, peux-tu joindre un fichier et insérer les explications dans ce fichier ?

Hello,

J'avais mis un fichier qui explique dans mon dernier message.

J'en joins un autre ici qui sera surement mieux

Up ?

re,

il est plus facile de supprimer les lignes de données inscrit pour ce No. de Code

et d'ajouter les nouvelles données au bas de la feuille.

est ce que ça irait de procéder de cette façon ?

Hello!!

Oui j’y pensais mais ça serait beaucoup mieux de faire la version « mise à jour » pour mes utilisateurs...

Je me creuse la tête pour trouver ce code qui irait je trouve pas....

re,

peut-il y avoir un code avec données

F5393 Bouteille Test test 2 PJ janvier-20 2019

et y avoir le même code avec d'autre données

F5393 Bouteille Test test 2 GH janvier-20 2019

que doit on faire dans ce cas ?

Ça serait pas gênant mais en soit ça sera jamais le cas. Il n’y aura jamais 2x le même code c’est impossible et c’est aussi le but de cette mise à jour

Rechercher des sujets similaires à "inserer ligne fonction resultat feuilles differentes"