Discussion :

[Xenna77]

Bonsoir,

J'ai pu obtenir ce code dans ce forum que j'ai un peu adapté et qui m'a bien aidé. J'aimerais cependant encore mieux l'adapter mais je n'y arrive pas. Ce script permet le transfert de certaines données d'une feuille vers une autre mais j'aimerais y intégré un message d'erreur s'il y a doublon (colonne A)

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, derLig As Integer, lignVide As Integer
If Target.Column <> 12 Then Exit Sub
derLig = Range("A" & Rows.Count).End(xlUp).Row
 
If Target.Row <> derLig Then Exit Sub
If ActiveCell = "RP" Then
'il y a 7 valeurs à transférer
v1 = Cells(derLig, 1): v2 = Cells(derLig, 2): v3 = Cells(derLig, 4)
v4 = Cells(derLig, 8): v5 = Cells(derLig, 9): v6 = Cells(derLig, 11)
'Ouvrir la feuill GM
Sheets("GM").Activate
Worksheets("GM").Unprotect Password:="XENNA"
 
'Recherche de la première ligne vide
lignVide = Sheets("GM").Range("A" & Rows.Count).End(xlUp).Row + 1
'Copie des valeurs dans la feuille active
With ActiveSheet
    .Cells(lignVide, 1) = v1 
    .Cells(lignVide, 2) = v3
    .Cells(lignVide, 4) = v6
    .Cells(lignVide, 5) = v2
    .Cells(lignVide, 8) = v4
    .Cells(lignVide, 9) = v5
End With
 
 
Worksheets("GM").Protect Password:="XENNA"
End If
 
 
End Sub

Merci !

[Invité]

Bonsoir,

Un exemple à incorporer dans ton code.

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
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim derLig As Integer, adresse As String
 If Target.Column <> 2 Then Exit Sub 'exemple avec saisies en A et B
 derLig = Range("A" & Rows.Count).End(xlUp).Row
 If Target.Row <> derLig Then Exit Sub
     v1 = Cells(derLig, 1)
        'Recherche si la nouvelle donnée existe déjà dans la colonne A.
        adresse = Columns(1).Find(What:=v1, After:=Range("A" & derLig).Offset(1, 0), _
        LookAt:=xlWhole, SearchDirection:=xlNext).Address
 
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If adresse <> Range("A" & derLig).Address Then _
            MsgBox "La donnée '" & v1 & _
            "' existe déjà dans la cellule " & adresse
End Sub

[Xenna77]

Bonsoir,

Merci bcp pour votre proposition mais je n'arrive pas à l'intégrer dans mon code , pourriez-vous m'aider davantage ?

Merci

[polysandre]

Bonjour,

Je me permets de te répondre.

Ce code est à intégrer dans le code de la feuille de ton classeur sur laquelle tu veux interdire les doublons ^^.

Quand tu as ta liste d'objets VBA en faisant Alt+F11, tu as une sous liste Microsof Excel Objects et là tu as tes noms de feuilles, tu cliques sur ta feuille concernée et tu colles ce code.

Polyasandre.

[vinc_bilb]

Bonjour,

Sauf incompréhension de ma part par manque de café chronique, vous pouvez supprimer directement les doublons par la fonction RemoveDuplicates (existe aussi en Excel classique).
Si ça peut aider

Code :

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

InpRng.RemoveDuplicates Columns:=(RngColAR), Header:=RngAsHeader

[Thautheme]

Bonjour le fil, bonjour le forum,

Bonjour,

Sauf incompréhension de ma part par manque de café chronique, vous pouvez supprimer directement les doublons par la fonction RemoveDuplicates (existe aussi en Excel classique).
Si ça peut aider

Code :

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

InpRng.RemoveDuplicates Columns:=(RngColAR), Header:=RngAsHeader

Belle découverte pour moi ! Je t'offre un café (virtuel) Vincent...

[vinc_bilb]

Haaa, un café virtuel est un objet non déclaré, donc méfiance! Merci ....

[Xenna77]

Bonsoir à tous,

Je vous remercie pour vos réponses, mais le code de Jean-Claude me convient mieux si ce n'est que j'aimerais compléter ce code en interdisant la copie des données. Dans celui-ci, il m'avertit juste qu'il y a un doublon mais il copie quand même les données. Quelqu'un pourrait m'aider à le compléter en laissant le MsgBox?

Merci pour l'intérêt que vous portez à ma demande.

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim derLig As Integer, adresse As String
 If Target.Column <> 2 Then Exit Sub 'exemple avec saisies en A et B
 derLig = Range("A" & Rows.Count).End(xlUp).Row
 If Target.Row <> derLig Then Exit Sub
     v1 = Cells(derLig, 1)
        'Recherche si la nouvelle donnée existe déjà dans la colonne A.
        adresse = Columns(1).Find(What:=v1, After:=Range("A" & derLig).Offset(1, 0), _
        LookAt:=xlWhole, SearchDirection:=xlNext).Address
 
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If adresse <> Range("A" & derLig).Address Then _
            MsgBox "La donnée '" & v1 & _
            "' existe déjà dans la cellule " & adresse
End Sub

NB: le café virtuel est en effet pas déclaré mais je peux t'assurer qu'il est meilleur pour la santé

[patricktoulon]

bonjour

personellement les activâtes et elect a tout va me font dresser les poils à moi
une suggestion

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
 
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim derLig As Long, lignVide As Long, tablo(1, 9) As Variant, doublon As Variant
    ici j 'ai reuni les 2 conditions de sortie de sub
    If Target.Column <> 12 Or Target.Row <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
 
    derLig = ActiveCell.Row ' ici si on est pas sorti alors on est forcement sur la derniere ligne
 
   If ActiveCell = "RP" Then
        'doublon va devenir la celle qui contient le doublon
        Set doublon = Range("A1:A" & derLig - 1).Find(Cells(derLig, 1), LookIn:=xlValues)
        If Not doublon Is Nothing Then ' si le doublon n'est pas rien alors message
        MsgBox "il y deja cette valeur en ligne :" & doublon.Row
        Else
        ' sinon on fait le boulot et sans tout ces activate qui paralisent le system
        'il y a 7 valeurs que l'on met dans la variables tablo dans les meme colonne que les colonne du  (sheets"GM")qui est la destination
        tablo(1, 1) = Cells(derLig, 1): tablo(1, 2) = Cells(derLig, 4): tablo(1, 4) = Cells(derLig, 11)
        tablo(1, 5) = Cells(derLig, 2): tablo(1, 8) = Cells(derLig, 9): tablo(1, 9) = Cells(derLig, 9)
        With Worksheets("GM")
            .Unprotect Password:="XENNA" ' on deprotege le sheets
            lignVide = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' on cherche la premiere ligne vide en partant d'en bas
           . Cells(lignevide, 1).Resize(1, 9) = tablo ' et enfin on repose le tablo (plus comunement appelé "TRANSPOSE")
            .Protect Password:="XENNA"
        End With
    End If
    End If
End Sub
j'ai pas tester mais ca devrait fonctionner

EDIT/
j'avais oublié le "." devant cells dans la boucle with du sheets("GM")

[Xenna77]

Bonsoir,

le script bloque à ce niveau :

Code :

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

 .Cells(lignevide, 1).Resize(1, 9) = tablo

Merci pour le suivi

[patricktoulon]

juste avant cette ligne met

Code :

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

msgbox "ligne vide =" & lignevide & vbcrlf & ubound(tablo) & vbcrlf  & tablo(1,1) & ": " &  tablo(1,9)

et dis moi ce que te dis le message ?

[Xenna77]

Erreur d'exécution 1004

Erreur définie par l'application ou l'objet

Débogage

[patricktoulon]

oula !!!il est tard hein

bon c'est pas grave

je repete

bloque cette ligne avec un apostrophe

Code :

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

.cells(lignevide,1).resize(1,9)=tablo

et juste au dessus de la ligne ajoute la ligne du msgbox que t'ai donné avant et dis moi ce que dit MON MESSAGE!!!! pas le message d'erreur

[Xenna77]

SORRY!

Ligne vide = 1

1: YBH (c'est le contenu de ma cellule I2 de ma feuille principale)

Merci

[patricktoulon]

donc mis a part le fait que tu te retrouve avec la valeur de la cellules 12 ce n'est pas mon tablo qui génère l'erreur
bien que 12 je comprend pas je la prend pas dans le tablo c'est bizarre
peut être pour des protéger il faut activer je vais modifier

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
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim derLig As Long, lignVide As Long, tablo(1, 9) As Variant, doublon As Variant
    ici j 'ai reuni les 2 conditions de sortie de sub
    If Target.Column <> 12 Or Target.Row <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
 
    derLig = ActiveCell.Row ' ici si on est pas sorti alors on est forcement sur la dernière ligne
 
   If ActiveCell = "RP" Then
        'doublon va devenir la celle qui contient le doublon
        Set doublon = Range("A1:A" & derLig - 1).Find(Cells(derLig, 1), LookIn:=xlValues)
        If Not doublon Is Nothing Then ' si le doublon n'est pas rien alors message
        MsgBox "il y deja cette valeur en ligne :" & doublon.Row
        Else
        ' sinon on fait le boulot et sans tout ces activate qui paralysent le system
        'il y a 7 valeurs que l'on met dans la variables tablo dans les meme colonne que les colonne du  (sheets"GM")qui est la destination
        tablo(1, 1) = Cells(derLig, 1): tablo(1, 2) = Cells(derLig, 4): tablo(1, 4) = Cells(derLig, 11)
        tablo(1, 5) = Cells(derLig, 2): tablo(1, 8) = Cells(derLig, 9): tablo(1, 9) = Cells(derLig, 9)
        With Worksheets("GM")
            .Activate
            .Unprotect Password:="XENNA" ' on déprotège le sheets
            lignVide = .Range("A" & Rows.Count).End(xlUp).Row + 1 ' on cherche la première ligne vide en partant d'en bas
            Cells(lignevide, 1).Resize(1, 9) = tablo ' et enfin on repose le tablo (plus communément appelé "TRANSPOSE")
            .Protect Password:="XENNA"
        End With
    End If
    End If
End Sub

mais je reste perplexe pour le 12

[Xenna77]

pas 12 , COLONNE I LIGNE 2 -> c'est la colonne 9.

Je dois améliorer mon café virtuel

[patricktoulon]

et puis il est tard hein!!!!!!

a force de trop on fait des bêtises

[patricktoulon]

JE SUIS MORT DE RIRE ET DE HONTE SURTOUT
dans la ligne en cause il y a "Cells(lignevide........."
hors c'est "Cells(lignvide.........."

bon je vais me coucher la parce que ca va plus

autant pour moi

[Xenna77]

Moi aussi car ca ne va plus ... Bonne nuit et merci quand même pour ton aide ...

[patricktoulon]

salut

ouais ya des soir ou il faudrait se coucher de plus bonne heure hein!!!

bon c'est moi qui avais déraillé

en fait on se servait de activecell hors activecell était la cellule en dessous de la concernée puisque pour déclencher l'évènement il faut au minimum appuyer sur enter

en fait il fallait se servir de target.row tout le long
bon voila ca marche

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
 
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim derLig As Long, lignVide As Long, tablo(1, 9), doublon As Variant
    ' ici j 'ai reuni les 2 conditions de sortie de sub
    If Target.Column <> 12 Or Target.Row <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
    derLig = Target.Row    ' ici si on est pas sorti alors on est forcement sur la dernière ligne
        If Target = "RP" Then
        'doublon va devenir la celle qui contient le doublon
        Set doublon = Sheets(1).Range("a1:a" & Target.Row - 1).Find(Cells(derLig, 1).Value, LookIn:=xlValues)
        If Not doublon Is Nothing Then  ' si le doublon n'est pas rien alors message
            MsgBox "il y deja cette valeur en ligne :" & doublon.Row
        Else
            ' sinon on fait le boulot et sans tout ces activate qui paralysent le system
            'il y a 7 valeurs que l'on met dans la variables tablo dans les meme colonne que les colonne du  (sheets"GM")qui est la destination
            tablo(1, 1) = Cells(derLig, 1): tablo(1, 2) = Cells(derLig, 4): tablo(1, 4) = Cells(derLig, 11)
            tablo(1, 5) = Cells(derLig, 2): tablo(1, 8) = Cells(derLig, 8): tablo(1, 9) = Cells(derLig, 9)
            With Worksheets("GM")
                .Activate
                .Unprotect Password:="XENNA"    ' on déprotège le sheets
                lignVide = IIf(.Range("A" & Rows.Count).End(xlUp).Row = 1, .Range("A" & Rows.Count).End(xlUp).Row, .Range("A" & Rows.Count).End(xlUp).Row + 1) ' on cherche la première ligne vide en partant d'en bas
                .Cells(lignVide, 1).Resize(1, 9) = tablo    ' et enfin on repose le tablo (plus communément appelé "TRANSPOSE")
                .Protect Password:="XENNA"
            End With
        End If
    End If
End Sub