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

Y compris Power BI, Power Query et toute autre question en lien avec Excel
M
MThev
Nouveau venu
Nouveau venu
Messages : 4
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é 10 fois
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'129
Appréciations reçues : 273
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
Merci! de faire un clic sur le bouton résolu pour nous aider à t'aider.
Si vous avez un doute :
annonces/explications-et-regles-a-respecter-t13.html

isabelle
M
MThev
Nouveau venu
Nouveau venu
Messages : 4
Inscrit le : 18 septembre 2019

Message par MThev » 19 septembre 2019, 14:12

i20100 a écrit :
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

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 : 5'129
Appréciations reçues : 273
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 ::(
Merci! de faire un clic sur le bouton résolu pour nous aider à t'aider.
Si vous avez un doute :
annonces/explications-et-regles-a-respecter-t13.html

isabelle
M
MThev
Nouveau venu
Nouveau venu
Messages : 4
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 : 5'129
Appréciations reçues : 273
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é 5 fois
Merci! de faire un clic sur le bouton résolu pour nous aider à t'aider.
Si vous avez un doute :
annonces/explications-et-regles-a-respecter-t13.html

isabelle
M
MThev
Nouveau venu
Nouveau venu
Messages : 4
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:
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message