Discussion :

[Xenna77]

Bonjour,

Cela fonctionne pas

Je me permets d'envoyer le fichier avec le script de base.

Le but est donc lorsque j'arrive à la colonne L, lorsque je choisis dans la liste de choix RM, il me copie les données concernées vers la feuille GM. Jusque là, tout va bien mais lorsque je reclique sur la colonne L de la même ligne, il m'avertit qu'il y a doublon mais il copie à nouveau les données vers la feuille GM. J'aimerais qu'il me signale que les données existe déjà dans la feuille GM et qu'il ne copie pas les données.

Merci !

[Theze]

Bonjour,

Teste ce code pour voir (je n'ai pas ouvert ton fichier) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Cel As Range
    Dim derLig As Long
    Dim lignVide As Long
    Dim V1
    Dim V2
    Dim V3
    Dim V4
    Dim V5
    Dim V6
 
    If Target.Column <> 12 Then Exit Sub
 
    derLig = Range("A" & Rows.Count).End(xlUp).Row
 
    If Target.Row <> derLig Then Exit Sub
 
    If Target.Value = "RP" Then
 
        'il y a 7 valeurs à transférer !!! moi je n'en vois que six ?
        V1 = Me.Cells(derLig, 1): V2 = Me.Cells(derLig, 2): V3 = Me.Cells(derLig, 4)
        V4 = Me.Cells(derLig, 8): V5 = Me.Cells(derLig, 9): V6 = Me.Cells(derLig, 11)
 
        'Ouvrir la feuill GM
        With Worksheets("GM")
 
            Set Cel = .Columns(1).Find(Me.Cells(derLig, 1), , xlValues, xlWhole)
 
            If Cel Is Nothing Then
 
               .Unprotect Password:="XENNA"
 
               'Recherche de la première ligne vide
               lignVide = .Range("A" & .Rows.Count).End(xlUp).Row + 1
 
               'Copie des valeurs dans la feuille "GM"
               .Cells(lignVide, 1) = V1
               .Cells(lignVide, 2) = V3
               .Cells(lignVide, 4) = V6
               .Cells(lignVide, 5) = V2
               .Cells(lignVide, 8) = V4
               .Cells(lignVide, 9) = V5
 
               .Protect Password:="XENNA"
 
            Else
 
                MsgBox "Enregistrement déjà existant dans la base de données !"
 
            End If
 
        End With
 
    End If
 
End Sub

Hervé.

Oups,

petite rectification, dans ton premier code, un des déclencheurs est le mot "RP" et maintenant, je viens de voir que tu utilise "RM" donc, fait la modif dans la ligne de code suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Target.Value = "RP" Then

Hervé.

[Xenna77]

Bonjour,

Super, ça fonctionne !!! et surtout MERCI !!!!

Encore une dernière chose svp, il faudrait que les données soient copiées seulement si toutes les colonnes sont complétées (si non un message MsgBox )
Encore Merci pour votre aide ...

[patricktoulon]

c'est assez simple dans le code ajouter la condition de la présence dans le sheets("GM") de la même manière que le test sur le sheet de base

[Xenna77]

Bonsoir,

J'ai essayé mais ça fonctionne pas comme je voudrais. Si seulement cela pouvait être aussi simple pour moi ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Cel As Range
    Dim derLig As Long
    Dim lignVide As Long
    Dim V1
    Dim V2
    Dim V3
    Dim V4
    Dim V5
    Dim V6
 
 
    If Target.Column <> 12 Then Exit Sub
 
 
    derLig = Range("A" & Rows.Count).End(xlUp).Row
 
    If Target.Row <> derLig Then Exit Sub
 
 
    If Target.Value = "RM" Then
 
    Set MaPlage = Sheets("GTT").Range("A2:L65000")
 
        For Each Cel In MaPlage
            If Cel.Value = "" Then 'si elle est vide alors message à l'utilisateur
 
                MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
                    'sortie de la procédure
        Exit Sub
    End If
 
    Next
 
            'il y a 6 valeurs à transférer
        V1 = Me.Cells(derLig, 1): V2 = Me.Cells(derLig, 2): V3 = Me.Cells(derLig, 4)
        V4 = Me.Cells(derLig, 8): V5 = Me.Cells(derLig, 9): V6 = Me.Cells(derLig, 11)
 
        'Ouvrir la feuill GM
        With Worksheets("GM")
 
            Set Cel = .Columns(1).Find(Me.Cells(derLig, 1), , xlValues, xlWhole)
 
            If Cel Is Nothing Then
            Sheets("GM").Activate
 
               .Unprotect Password:="XENNA"
 
               'Recherche de la première ligne vide
               lignVide = .Range("A" & .Rows.Count).End(xlUp).Row + 1
 
               'Copie des valeurs dans la feuille "GM"
               .Cells(lignVide, 1) = V1
               .Cells(lignVide, 2) = V3
               .Cells(lignVide, 4) = V6
               .Cells(lignVide, 5) = V2
               .Cells(lignVide, 8) = V4
               .Cells(lignVide, 9) = V5
 
               .Protect Password:="XENNA"
 
            Else
 
                MsgBox "Enregistrement déjà existant dans la base de données !"
 
            End If
 
        End With
 
    End If
 
End Sub

[Invité]

Bonsoir,

J'étais décidé à écrire le module complet tenant compte de tes différents désidératas.
Je charge ton fichier exemple et pour pouvoir tester ma première mouture je me lance à vouloir saisir une ligne exemple.
Je suis tout étonné de constater que la colonne A ne permet pas la saisie de doublons, la "Validation des données" étant paramétrée.
Peux-tu m'éclairer ?
Pourquoi nous demander d'écrire en VBA une recherche qui ne peut être vraie puisqu'interdite par ailleurs ?