Option Explicit

 Const extMapPath As String = "C:\Berlin\Test_Otto.xlsm"

 Const extSh  As String = "Test"

 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'Alwin Weisangler  klappt super

    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: " & vbNewLine & tmp(1) & "    " & tmp(0) & " enthalten!", vbExclamation, "A C H T U N G"

                    Target = ""

                    Target.Select

                Else

                    If WorksheetFunction.CountIf(Wks.Columns(1), Target) > 1 Then

                        MsgBox "Die Lfd. Nr. " & Target & " ist bereits in Zelle: " & vbNewLine & Wks.Cells(Application.Match(Target, Wks.Columns(1), 0), 1).Address(0, 0) & "   " & Target.Parent.Name & " enthalten!", vbExclamation, "A C H T U N G"

                                          

                        

                        Target = ""

                        Target.Select

                    End If

                End If

            Next

        Next

    End If

    Application.EnableEvents = True

    Call AbgleichExtern(Target)

End Sub



Sub AbgleichExtern(lfdNr As Variant)

    Dim rs As Object, arr, i&, k&, datN

    Set rs = CreateObject("ADODB.Recordset")

    With rs

        .CursorLocation = 3

        .CursorType = 3

        .Open "SELECT * FROM [" & extSh & "$]", "Provider=Microsoft.ACE.OLEDB.12.0;" & "Extended Properties=""Excel 12.0 xml"";" & "Data Source= " & extMapPath

        If (.EOF And .BOF) = False Then

            arr = .GetRows

        End If

        .Close

    End With

    Set rs = Nothing

    For i = LBound(arr, 2) To UBound(arr, 2)

        If IsNumeric(arr(2, i)) Then arr(2, i) = CDbl(arr(2, i))

        If arr(2, i) = lfdNr Then k = k + 1

    Next i

    datN = Right(extMapPath, Len(extMapPath) - InStrRev(extMapPath, "\"))

    If k = 0 Then MsgBox "Lfd. Nummer " & lfdNr & "  ist nicht in Datei: " & datN & "! vorhanden", vbOKOnly, "Fehler!!!"

End Sub