Aide sur Macro Copy

[MuscatMimi]

Bonjour a tout le Forum

Dans le fichier joint il y a toutes les explications,concernant ma
demande
Cordialement

 

[Staple1600]

Re : Aide sur Macro Copy

Bonjour vaucluseimmo, le fil

Tu es pourtant XLDnaute accro....
Extrait de la charte

b) La Question dans le message doit contenir un maximum d’informations, plus vous donnerez de détails, plus il sera facile de vous répondre. Mettez vous à la place des Lecteurs, ils ne peuvent pas imaginer votre problème. Les abréviations sont à éviter, nous sommes dans un Forum, pas un chat. Prenez le temps de rédiger clairement votre question, et songez que tronquer tous les mots fatigue la lecture (Idem pour les Majuscules qui en plus signifient ' crier ')

Qu'un nouveau membre ne le sache pas, c'est compréhensible.

Qu'un membre inscrit depuis 2007 l'ignore, cela l'est beaucoup moins non ?

 

[MuscatMimi]

Re : Aide sur Macro Copy

Bonjour Stapple et le forum

je sais tout ça

Milles excuses de ne pas l'avoir fait
Dans ce fichier il y a une macro qui fonctionne bien,macro récupérée sur ce site
mais je ne sais pas qui l'a crée
Dans la Feuil Bdd,On doubleCliq sur une ligne d'une colonne D; et ça copy la ligne dans la Feuil1,et
un X est affiché dans la colonne D
Un nouveau doublecliq,ça éfface le X dans la colonne D,et les données copiées dans la feuil1
la c'est OK

Ce que je n'arrive pas a modifier dans cette macro, c'est de pouvoir copier
les données a partir de la 5 Ligne dans la Feuil1
Ensuite,
Je désire doublecliquer dans la colonne F,pour faire la même action, que décrit ci-dessus,
mais cette fois il faut que ça copy la ligne
dans la Feuil2, a la Ligne 5

Merci de votre aide
Cordialement

 

[Robert]

Re : Aide sur Macro Copy

Bonjour le fil, bonjour le forum,

En pìèce jointe ton fichier modifié avec le code commenté ci-dessous :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pl As Range 'déclare la variable pl (PLage)
Dim oc As Worksheet 'déclare la variable oc (Onglet Cible)
Dim coul As Byte 'déclare la variable coul (COULeur)
Dim dc As Integer 'déclare la variable dc (décalage Colonne)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim i As Byte 'déclare la variable i (décalage de colonne)
 
If Target.Row = 1 Then Exit Sub 'si le double-clic a lieu dans la ligne 1, sort de la procédure
Set pl = Range(Cells(Target.Row, 1), Cells(Target.Row, 3)) 'définit la plage pl (les cellules des colonnes A à C)
'si les trois données, "Nom", "Quantité" et "Prix moyen" ne sont pas renseignées, sort de la procédure
If Application.WorksheetFunction.CountA(pl) < 3 Then Exit Sub
 
Select Case Target.Column 'agit en fonction du numéro de colonne de la cellule double-cliquée
    Case 4 'cas 4 (D)
        Set oc = Sheets("Produits a Acheter") 'définit l'onglet cible
        coul = 36 'définit la couleur coul
        dc = 1 'définit le décalage de colonne
    Case 5 'cas 4 (E)
        Set oc = Sheets("Produits Commandés") 'définit l'onglet cible
        coul = 35 'définit la couleur coul
        dc = -1 'définit le décalage de colonne
    Case Else 'tous les aurtes cas
        Exit Sub 'sort de la proc;édure
End Select 'fin de l'action en fonction de...
 
Cancel = True 'évite le mode édition lié au double clic
If Target.Value = "" Then 'condition 1 : si la cellule est vide
    Target.Value = "X" 'place un "X" dans la cellule
    Target.Interior.ColorIndex = coul 'colore la cellule de jaune clair (colonne D) ou de vert clair (colonne E)
    Set dest = oc.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
    pl.Copy dest 'copie la plage pl dans dest
    oc.Range(dest, dest.Offset(0, 2)).Interior.ColorIndex = xlNone 'supprime une eventuelle couleur dans la plage copiée
    pl.Interior.ColorIndex = coul 'colore la plage de jaune clair ou de vert clair
 
ElseIf Target.Value = "X" Then 'condition 2 : si la cellule contient "X"
    Target.Value = "" 'efface la cellule
    Target.Interior.ColorIndex = xlNone 'supprime la couleur
    pl.Interior.ColorIndex = IIf(Target.Offset(0, dc) = "X", coul - dc, xlNone) 'supprime ou change la couleur
    Set r = oc.Columns(1).Find(Cells(Target.Row, 1), , xlValues, xlWhole) 'définit la recherche r
    If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
        pa = r.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            For i = 2 To 3 'boucle sur les colonne B et C
                'si la quantité ou le prix moyen diffèrent, va à l'étiquette "suite" (sans effacer la ligne)
                If Cells(Target.Row, i).Value <> r.Offset(0, i - 1).Value Then GoTo suite
            Next i 'prochaine colonne de la boucle
            oc.Rows(r.Row).Delete 'efface la ligne de l'occurrence trouvée
            oc.Rows(29).Insert Shift:=xlDown 'rajoute une ligne vierge à la fin
            Exit Sub 'sort de la procédure
suite: 'étiquette
            Set r = oc.Columns(1).FindNext(r) 'redéfinit r (occurrence suivante)
        'boucle tant qu'il existe des occurrences ailleurs qu'en pa
        Loop While Not r Is Nothing And r.Address <> pa
    End If 'fin de la condition
End If 'fin des condition 1 et  2
End Sub

Remarque : la ligne

oc.Rows(29).Insert Shift:=xlDown 'rajoute une ligne vierge à la fin

va poser problème si tu as plus de 29 produits. Efface-la et formate tes tableaux avec plus de lignes au départ...

Le fichier :

 

[MuscatMimi]

Re : Aide sur Macro Copy

Bonjour Robert et le Forum
Mince j'ai pas reçu de mail d'avertissement de nouvelles réponse

Désolé je viens de rechercher mon fil, et je vois que tu m'a répondu
Grand merci a toi,
Ca fonctionne comme je le demandais,super
Par contre petite idée de derniére minute,et si tu a du temps
Est-t'il possible de copier les Lignes que dans une seule feuille,
si Dble Cliq dans Col D,Copy + Color la Ligne en Vert & Police Blanche
si Dble Cliq dans Col E,Copy + Color la Ligne en Rouge & Police Blanche

Merci a bientôt de te lire
Bonne journée

 

[MuscatMimi]

Re : Aide sur Macro Copy

Bonjoiur a tous

Petit up pour remonter ce fil,car plus de réponse
Bon week-end
Cordialement

 

[MuscatMimi]

Re : Aide sur Macro Copy

Bonsoir a tous

Bon apparament personne pour répondre a mon probléme
pas grave
Cordialement