Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim Wks As Worksheet, Z As Range, tmp, vTar As Range ' vTar für den Fall das Target früh gelesen werden soll

    If Not Intersect(Target, Range("A10:A10000")) Is Nothing Then

        If Target.Text = "" Then Exit Sub

        Application.EnableEvents = False

        Set vTar = Target   ' frühes Übergeben des Target.Value

        If IsNumeric(Target.Value) Then Target = CDbl(Target.Value)

        For Each Wks In Sheets

            For Each Z In Wks.Range("A10:A" & Wks.Cells(Rows.Count, 1).End(xlUp).Row)

                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(vTar) 'für den Fall das Target spät gelesen werden soll dann: Call AbgleichExtern(Target)

End Sub



Sub AbgleichExtern(lfdNr As Range)

    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.Value Then k = k + 1

    Next i

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

    If k = 0 Then

        MsgBox "Lfd. Nummer " & lfdNr.Value & "  ist nicht in Datei: " & datN & "! vorhanden", vbOKOnly, "Fehler!!!"

        Application.EnableEvents = False

        lfdNr = ""

        lfdNr.Activate

        Application.EnableEvents = True

    End If

End Sub