Option Explicit
'Verweise Microsoft Scripting Runtime
'Ereignisprozedur ins Modul DieseArbeitsmappe
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
Dim oDict As New Scripting.Dictionary, Item
'nur 1 Zelle
If target.Count > 1 Then Exit Sub
'Definition wo, was
oDict.Add Key:="Tabelle1", Item:="B2:C3"
oDict.Add Key:="Tabelle3", Item:="B2:C3,E4,F4,E6,E8"
oDict.Add Key:="Tabelle6", Item:="B3,C5:D6"
'keine Übereinstimmung
If Not oDict.Exists(Sh.Name) Then Exit Sub
If Intersect(Sh.Range(oDict.Item(Sh.Name)), target) Is Nothing Then Exit Sub
'beschreiben
Application.EnableEvents = False
For Each Item In oDict
Sheets(Item).Range(oDict(Item)).Value = target.Value
Next Item
Application.EnableEvents = True
End Sub
|