XL 2019 interdire doublons sur plusieurs feuilles

salbingu

XLDnaute Nouveau
bonsoir à tous.
j'ai un classeur qui contient un tableau identique sur plusieurs feuilles. j'aimerai que si la cellule A1 de la feuille 1 contient une valeur x, il soit impossible de saisir la meme valeur sur les cellules A1 des autres feuilles.
si quelqu'un a une idée je suis prenneur. merci
 
Solution
Bonjour salbingu, JHA, le forum,

La question me paraît pourtant assez claire, voyez le fichier joint et cette macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim F As Worksheet, x$
Set F = Feuil1 'feuille de référence
If Sh.Name = F.Name Then Exit Sub
Set Target = Intersect(Target, Sh.UsedRange)
If Target Is Nothing Then Exit Sub
For Each Target In Target
    x = LCase(CStr(Target))
    If x <> "" Then
        If Target.Row > 1 Then
            If x = LCase(CStr(F.Range(Target.Address))) Then
                Application.EnableEvents = False 'désactive les évènements
                Application.Undo 'annule l'entrée
                Application.EnableEvents = True 'réactive...

job75

XLDnaute Barbatruc
Bonjour salbingu, JHA, le forum,

La question me paraît pourtant assez claire, voyez le fichier joint et cette macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim F As Worksheet, x$
Set F = Feuil1 'feuille de référence
If Sh.Name = F.Name Then Exit Sub
Set Target = Intersect(Target, Sh.UsedRange)
If Target Is Nothing Then Exit Sub
For Each Target In Target
    x = LCase(CStr(Target))
    If x <> "" Then
        If Target.Row > 1 Then
            If x = LCase(CStr(F.Range(Target.Address))) Then
                Application.EnableEvents = False 'désactive les évènements
                Application.Undo 'annule l'entrée
                Application.EnableEvents = True 'réactive les évènements
                Exit Sub
            End If
        End If
    End If
Next
End Sub
A+
 

Pièces jointes

  • Doublons(1).xlsm
    21.2 KB · Affichages: 23

salbingu

XLDnaute Nouveau
Bonjour salbingu, JHA, le forum,

La question me paraît pourtant assez claire, voyez le fichier joint et cette macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim F As Worksheet, x$
Set F = Feuil1 'feuille de référence
If Sh.Name = F.Name Then Exit Sub
Set Target = Intersect(Target, Sh.UsedRange)
If Target Is Nothing Then Exit Sub
For Each Target In Target
    x = LCase(CStr(Target))
    If x <> "" Then
        If Target.Row > 1 Then
            If x = LCase(CStr(F.Range(Target.Address))) Then
                Application.EnableEvents = False 'désactive les évènements
                Application.Undo 'annule l'entrée
                Application.EnableEvents = True 'réactive les évènements
                Exit Sub
            End If
        End If
    End If
Next
End Sub
A+
Merci infiniment.
J'avais mis ce projet aux oubliettes faute de solution. Je l'ai déterré pour nécessité de service et boom ! Je trouve qu'il a été résolu
 

Discussions similaires

Statistiques des forums

Discussions
311 716
Messages
2 081 848
Membres
101 826
dernier inscrit
dododu89