Empecher un doublon
Résolu
rodger85230
Messages postés
9
Statut
Membre
-
rodger85230 Messages postés 9 Statut Membre -
rodger85230 Messages postés 9 Statut Membre -
Bonjour,
j’ai récupéré une macro qui empêche les doublons sur la feuil1
mais pour moi il faut que cela soit sur deux feuilles (1 et 2)
et je n'y arrive pas voici le code
------------------------------

----------------------------------------
merci d'avance
**Modifié par la modération pour une lecture plus facile du code, à l'avenir utilisez les balises, VOIR CETTE PAGE
Configuration: Windows / Chrome 74.0.3729.157
j’ai récupéré une macro qui empêche les doublons sur la feuil1
mais pour moi il faut que cela soit sur deux feuilles (1 et 2)
et je n'y arrive pas voici le code
------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$1" Or Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub 'pour éviter des appels successifs
Dim Dli As Long
Dli = Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(Range("A1:A" & Dli), Target) > 0 Then
MsgBox Target & " est déjà dans la liste", vbInformation, "pas accepté :"
Target = ""
End If
Target.Select
End Sub
----------------------------------------
merci d'avance
**Modifié par la modération pour une lecture plus facile du code, à l'avenir utilisez les balises, VOIR CETTE PAGE
1 réponse
-
Bonjour,
comme ceci:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$D$1" Or Target.Count > 1 Then Exit Sub If Target = "" Then Exit Sub 'pour éviter des appels successifs Dim Dli As Long Dim derniereLigne As Long Dli = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row derniereLigne = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row If Application.CountIf(Range("A1:A" & Dli), Target) > 0 Or Application.CountIf(Worksheets("Feuil2").Range("A1:A" & derniereLigne), Target) > 0 Then MsgBox Target & " est déjà dans la liste", vbInformation, "pas accepté :" Target = "" End If Target.Select End Sub
-
-
Voilà:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Dli As Long Dim derniereLigne As Long If Not Intersect(Target, Range("A:A")) Is Nothing Then If Target = "" Then Exit Sub 'pour éviter des appels successifs Worksheets("Feuil2").Range("A" & Target.Row) = Worksheets("Feuil1").Range("A" & Target.Row) Worksheets("Feuil2").Range("A" & Target.Row).NumberFormat = "m/d/yyyy" 'a adapter le format End If If Target.Address <> "$D$1" Or Target.Count > 1 Then Exit Sub Dli = Worksheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row derniereLigne = Worksheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row If Application.CountIf(Range("A1:A" & Dli), Target) > 0 Or Application.CountIf(Worksheets("Feuil2").Range("A1:A" & derniereLigne), Target) > 0 Then MsgBox Target & " est déjà dans la liste", vbInformation, "pas accepté :" Target = "" End If Target.Select End Sub
@+ Le Pivert -
Bonjour
en fait je vais reprendre la première macro mais maintenant j'ai un autre problème c'est quand je lance une macro pour copier les données même si la date existe dans "histotest" colonne A, la macro (copie) me les copies . serait'il possible de rajouter dans cette macro de (copie) qu'il regarde si la date mise en colonne A "Donnée" est présente dans la colonne A dans "histotest" si oui avoir un message et stopper la macro ,si non que la macro continu pour la copie , voici la macroSub Copie()
If Sheets("Donnée").range("C3") = "" Then Exit Sub
Dim cDest As range
With Sheets("histotest")
Set cDest = .range("A" & Rows.Count).End(xlUp)(2)
cDest.Resize(, 6).Value = Array(range("c3").Value, range("c6").Value, range("c7").Value, range("c8").Value, range("c9").Value, range("c10").Value)
'Load UserForm1
'UserForm1.Show
Sheets("histotest").Select
End With
Merci d'avance -
-