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

Y compris Power BI, Power Query et toute autre question en lien avec Excel
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 18 septembre 2019, 20:59

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 ? :lole:
Merci beaucoup !!! :) :)
TestVBA.xlsx
(12.62 Kio) Téléchargé 12 fois
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 6'041
Appréciations reçues : 352
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 19 septembre 2019, 01:14

Bonjour MThev, et bienvenue,
:bv:

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
Prenons soins de nous et de notre vaisseau spatial, nous n’en n’avons qu’un ...notre planète terre
isabelle
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 19 septembre 2019, 14:12

Bonjour i20100,

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

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 !! :)
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 6'041
Appréciations reçues : 352
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 19 septembre 2019, 21:04

re,

sans voir le fichier c'est difficile de trouver l'erreur ::(
Prenons soins de nous et de notre vaisseau spatial, nous n’en n’avons qu’un ...notre planète terre
isabelle
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 20 septembre 2019, 10:23

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 !!
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 6'041
Appréciations reçues : 352
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 20 septembre 2019, 16:40

re,

j'ai fais quelque modification, dit-moi si c'est ok ?
MThev-TestVBA.xlsm
(21.32 Kio) Téléchargé 8 fois
Prenons soins de nous et de notre vaisseau spatial, nous n’en n’avons qu’un ...notre planète terre
isabelle
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 23 septembre 2019, 09:27

i20100 a écrit :
20 septembre 2019, 16:40
re,

j'ai fais quelque modification, dit-moi si c'est ok ?
MThev-TestVBA.xlsm
C'est parfait !! Merci beaucoup !! :mrgreen: :mrgreen:
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 24 octobre 2019, 09:57

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 !! :)
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 24 octobre 2019, 16:54

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
M
MThev
Jeune membre
Jeune membre
Messages : 26
Inscrit le : 18 septembre 2019

Message par MThev » 25 octobre 2019, 18:32

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

Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message