Gruppe
Ereignis
Problem
Es soll verhindert werden, dass je Zeile Doppeleintragungen über alle Tabellen im Bereich A1:B20 erfolgen.
ClassModule: DieseArbeitsmappe
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wks As Worksheet
If Intersect(Target, Range("A1:B20")) Is Nothing Then Exit Sub
For Each wks In Worksheets
If wks.Name <> Sh.Name Then
If WorksheetFunction.CountIf( _
wks.Range(wks.Cells(Target.Row, 1), _
wks.Cells(Target.Row, 100)), Target.Value) > 0 Then
Beep
MsgBox "Eingabe schon vorhanden in Blatt " & wks.Name & "!"
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
End If
End If
Next wks
End Sub