Als Antwort auf diesen Beitrag
Hallo Sabrina,
Mir ist jetzt erst deine Anfrage aufgefallen.
Hier mal ein Weg weitestgehend fehlerbehandelt. und mit Prüfung auf Doppelte im gleichen Blatt.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Wks As Worksheet, Z As Range, tmp
If Not Intersect(Target, Range("A10:A10000")) Is Nothing Then
If Target.Text = "" Then Exit Sub
Application.EnableEvents = False
If IsNumeric(Target.Value) Then Target = CDbl(Target.Value)
For Each Wks In Sheets
For Each Z In Wks.Range("A10:A10000").SpecialCells(xlCellTypeConstants)
If Not IsError(Application.Match(Target, Z.Columns(1), 0)) And Z.Parent.Name <> Target.Parent.Name Then
tmp = Split(Right(Z.Address(0, 0, , True), Len(Z.Address(0, 0, , True)) - InStrRev(Z.Address(0, 0, , True), "]")), "!")
MsgBox "Die Lfd. Nr. " & Target & " ist bereits in Zelle: " & tmp(1) & " im Blatt: " & tmp(0) & " enthalten."
Target = ""
Else
If WorksheetFunction.CountIf(Wks.Columns(1), Target) > 1 Then
MsgBox "Die Lfd. Nr. " & Target & " ist bereits in Zelle: " & Wks.Cells(Application.Match(Target, Wks.Columns(1), 0), 1).Address(0, 0) & " im Blatt: " & Target.Parent.Name & " enthalten."
Target = ""
End If
End If
Next
Next
End If
Application.EnableEvents = True
End Sub
Gruß Uwe