EXCEL - Copier et coller une ligne en fonction d'une cellule.

-Polito- Messages postés 3 Date d'inscription   Statut Membre Dernière intervention   -  
-Polito- Messages postés 3 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Je suis actuellement sur un travail de création d'un système de devis à l'aide du logiciel Microsoft Excel 2013. Pour celui-ci, j'ai organisé les différents éléments à la vente sur différentes feuilles. Par exemple, tous les objets d'un tel type (admettons des agrafeuses) se retrouverons sur une feuille dédiée nommée "AGRAFEUSES", les clés USB sur une autre feuille nommée "CLEUSB" et ainsi de suite.
Sur chacune de ces feuilles se trouvent plusieurs éléments, comme les agrafeuses bleues, roses, ou les clés USB de 16, 32 ou 64 Go. Devant chacune des feuilles se trouve une colonne Quantité dans laquelle on entrera un nombre correspondant au nombre d'items voulus.
En admettant que la ligne 1 de la feuille "AGRAFEUSES" représente les agrafeuses de couleur bleue :
- A1 est la cellule dans laquelle rentrer la quantité voulue,
- B1 la description de l'objet,
- C1 le prix à l'unité de l'objet,
- D1 le prix en fonction de la quantité voulue.
Et ceux de la sorte pour la ligne 2, 3, 4 etc..

Sur ce classeur se trouve une feuille prénommée "DEVIS", dans laquelle je souhaiterais que se situe une copie de tous les éléments sélectionnés.
Mon idée était la suivante :
- Trouver le moyen de détecter dans les colonnes A la présence une cellule contenant un nombre supérieur ou égal à 1.
- Faire en sorte que les lignes détectées soit copiées, puis collées à la suite sur la feuille nommée "DEVIS".
Par exemple :
Admettons qu'une agrafeuse soit à 3€ pièce. Si l'on sélectionne 2 dans la colonne A1, nous aurons dans B1 la description (donc cellule inchangée), dans C1 3€ et donc dans D1 6€ (A1*C1, soit 2*3). Aucun problème jusque là.
Maintenant, il faudrait que la cellule A1 soit détectée comme > ou = à 1 et que la ligne 1 soit entièrement copiée et collée sur la feuille du classeur nommée "DEVIS" dans mon cas à partir de la ligne 41. L'idéal serait que dans l'éventualité où plusieurs éléments seraient choisis, ceux -ci apparaîtraient à la suite les uns des autres. Si cette option semble impossible, est-il possible que chaque ligne possède une ligne associée dans la feuille "DEVIS" ? (Ex : La ligne 1 de la feuille "AGRAFEUSES" est associée à la ligne 41 de la feuille "DEVIS", de telle façon, si la cellule A1 de "AGRAFEUSES" contient un nombre > ou = à 1, elle se copiera à la ligne 41 de "DEVIS".

J'avais pour cela pensé à la fonction SI, mais ne la maîtrisant pas, je ne sais comment procéder. De plus, celle-ci ne me semble pas la solution la plus adaptée et je pense alors au VBA. Mais encore une fois, je ne sais alors comment procéder.
Je tiens absolument à ce système avec la feuille "DEVIS", car il me suffirait alors de faire un PDF de cette feuille pour obtenir un devis propre. Même si quelques retouches seraient nécessaires, le système avec lignes dédiées me conviendrait parfaitement.

En espérant avoir été le plus clair possible, je reste tout de même à l'écoute de la moindre de vos questions (et/ou réponses) !
Je m'en remets donc à vous Ô Maîtres d'Excel et du VBA, puissiez-vous m'aider dans ma quête ! :D

Merci d'avance et bien à vous,
Polito.

A voir également:

1 réponse

Réponse 1 / 1
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Ton idée est bonne mais fortement incomplète.
Il faut également penser aux cas suivants :
> suppression d'une ligne de la feuille devis par remise à 0 d'une des lignes des autres feuilles
> modification d'une quantité.

Le code ci-dessous tient compte de cela.
Pour insérer le code dans ton classeur :
> Alt+F11 (>affichage fenêtre VBE)
> Double clic dans la fenêtre VBA-Project sur ThisWorkbook
> Copier/Coller le code ci-dessous dans la fenêtre centrale.
> Adapter le nom de la feuille. Ici : Const ShDEVIS As String = "Devis"
> fermer VBE et tester. 

Option Explicit

    Dim Ligne As Integer
    Dim Trouve As Range
    Const ShDEVIS As String = "Devis" ' ADAPTER : le nom EXACT de la feuille devis

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        If Sh.Name = ShDEVIS Or Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub
        Select Case Target.Value
            Case Is >= 1
                Call AddToDevis(Target.Resize(1, 4))
            Case ""
                Call DeleteToDevis(Target.Resize(1, 4))
            Case Else
                MsgBox "Ne devrait jamais se produire"
        End Select
    End Sub
    
    Private Sub AddToDevis(Rng As Range)
        With Sheets(ShDEVIS)
            Set Trouve = .Columns(2).Cells.Find(Rng.Cells(1, 2))
            If Not Trouve Is Nothing Then
                Ligne = Trouve.Row
            Else
                Ligne = IIf(.Range("A41") = "", 41, .Range("A40").End(xlDown).Row + 1)
            End If
            .Range("A" & Ligne & ":D" & Ligne).Value = Rng.Value
        End With
    End Sub
    
    Private Sub DeleteToDevis(Rng As Range)
        With Sheets(ShDEVIS)
            Set Trouve = .Columns(2).Cells.Find(Rng.Cells(1, 2))
            If Not Trouve Is Nothing Then
                Ligne = Trouve.Row
            Else
                Exit Sub
            End If
            .Rows(Ligne).Delete
            Ligne = IIf(.Range("A41") = "", 41, .Range("A" & Ligne).End(xlDown).Row + 1)
            .Rows(Ligne).Insert Shift:=xlDown
        End With
    End Sub


Ci-joint un fichier exemple

Les suppressions de quantité devront être faites une par une pour supprimer dans la feuille devis la(es) ligne(s) correspondante(s).

Avant, j'arrivais jamais à finir mes phrases... mais maintenant je
1
-Polito- Messages postés 3 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Je te remercie infiniment pour ton aide, tu me sors d'une impasse monstrueuse ! Je file l'appliquer !
Je souhaiterai savoir si possible quelles sont les données à modifier si jamais je souhaite ajouter de nouvelles cellules à la sélection. (Exemple E1, F1, etc...)
Encore une fois, merci.

Polito
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > -Polito- Messages postés 3 Date d'inscription   Statut Membre Dernière intervention  
 
Excuse moi, je n'avais pas vu ta question subsidiaire.
Les lignes de code à modifier, dans ce cas, sont indiquées par un commentaire : A MODIFIER AU CAS OU : 
Option Explicit

    Dim Ligne As Integer
    Dim Trouve As Range
    Const ShDEVIS As String = "Devis" ' ADAPTER : le nom EXACT de la feuille devis

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        If Sh.Name = ShDEVIS Or Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub
        Select Case Target.Value
            Case Is >= 1
                Call AddToDevis(Target.Resize(1, 4)) 'A MODIFIER AU CAS OU
            Case ""
                Call DeleteToDevis(Target.Resize(1, 4)) 'A MODIFIER AU CAS OU
            Case Else
                MsgBox "Ne devrait jamais se produire"
        End Select
    End Sub
    
    Private Sub AddToDevis(Rng As Range)
        With Sheets(ShDEVIS)
            Set Trouve = .Columns(2).Cells.Find(Rng.Cells(1, 2))
            If Not Trouve Is Nothing Then
                Ligne = Trouve.Row
            Else
                Ligne = IIf(.Range("A41") = "", 41, .Range("A40").End(xlDown).Row + 1)
            End If
            .Range("A" & Ligne & ":D" & Ligne).Value = Rng.Value  'A MODIFIER AU CAS OU
        End With
    End Sub
    
    Private Sub DeleteToDevis(Rng As Range)
        With Sheets(ShDEVIS)
            Set Trouve = .Columns(2).Cells.Find(Rng.Cells(1, 2))
            If Not Trouve Is Nothing Then
                Ligne = Trouve.Row
            Else
                Exit Sub
            End If
            .Rows(Ligne).Delete
            Ligne = IIf(.Range("A41") = "", 41, .Range("A" & Ligne).End(xlDown).Row + 1)
            .Rows(Ligne).Insert Shift:=xlDown
        End With
    End Sub


Tout d'abord : 
Target.Resize(1, 4)

Target est forcément une cellule unique de la colonne A de la feuille active.
Pourquoi?
Parce qu'on a fait ces 2 tests préalablement : 
Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub

C'est à dire : si la colonne n'est pas la première ou si on a sélectionné plus d'une cellule alors ...on sort de la procédure et on ne fait rien.
Donc Target est une cellule de la colonne A. 
Resize(ligne, colonne)
sert à redimensionner notre Range. Ici on le redimensionne sur une ligne et quatre colonnes : 
.Resize(1, 4)
.
Si l'on considère partir de la colonne A, Resize 1 ligne 4 colonnes, va nous donner un Range de la colonne A à la colonne ....... D !
Par exemple : 
Range("A10").Resize(1, 4)
équivaut à 
Range("A10:D10")
, au même titre que 
Range("E2").Resize(2, 10)
équivaut à : 
Range("E2:N3")
.
Ok?
Donc, Si tu veux copier/coller tes données des colonnes A à F plutôt que de A à D, remplace : 
Target.Resize(1, 4)

par : 
Target.Resize(1, 6)

Tout simplement.

Je te laisse deviner ce que tu dois faire de cette ligne : 
 .Range("A" & Ligne & ":D" & Ligne).Value = Rng.Value

A mon avis tu devrais trouver par quoi remplacer : ":D" si tu copie/colle jusqu'à F.......


Par contre, qu'elles que soient les modifications, il faut que le nom des "produits" reste en colonne B.
Sinon, il conviendra de modifier les lignes : 
Set Trouve = .Columns(2).Cells.Find(Rng.Cells(1, 2))

.Columns(2)
deviendrait 
.Columns(4)
par exemple si les noms de tes objets étaient en colonne D plutôt qu'en B...
Idem pour 
Rng.Cells(1, 2)
qui deviendrait 
Rng.Cells(1, 4)
dans un tel cas.

C'est bon?
0
-Polito- Messages postés 3 Date d'inscription   Statut Membre Dernière intervention   > pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention  
 
Bonjour,

Pardon de répondre si tardivement. Encore une fois, merci pour ton aide et tes explications on ne peut plus précises, mon problème semble réglé !

Bonne continuation,
Polito
0

Discussions similaires

Excel : colorer une cellule sous condition d'une autre ?
KAKEPATHEL -
Pascal -

15 réponses