Empecher un doublon

Résolu
rodger85230 Messages postés 9 Statut Membre -  
rodger85230 Messages postés 9 Statut Membre -
Bonjour,
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

  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
    
    


    0
    1. rodger85230 Messages postés 9 Statut Membre
       
      Bonjour et Merci
      Votre réponse est la bonne , mais ma question n’était pas entière
      serait'il possible que les dates qui s'inscrivent en feuil1 colonne A se retrouvent également sur la feuil2
      merci d'avance
      0
    2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
      0
    3. rodger85230 Messages postés 9 Statut Membre
       
      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 macro
      Sub 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
      0
    4. rodger85230 Messages postés 9 Statut Membre
       
      Merci cs-picvert ne pas tenir en compte mon dernier message
      ce que vous m'avez donné marche très bien
      je marque comme résolue
      0