Hallo zusammen,
bei Änderung einer Zelle z.B. manuelle Eingabe in eine Zelle oder
bei Änderung mehrerer Zellen z.B. wenn von einer anderen Excel-Tabelle ein Bereich manuell hineinkopiert wird
1. wird im Bereich F4:Q500 etwas geändert, dann vergleiche
2. die aktive Zelle oder der Zellbereich der gerade aktiv ist mit der(n) zugehörigen Zelle oder Zellbereich der 30 Spalten weiter rechts steht.
3. ist eine Zelle anders als die Referenzzelle 30 Spalten weiter rechts so färbe die Zelle blau ein und trage in der aktuellen Zeile in Spalte "D" das heutige Datum ein
Anbei mein Anfängerversuch - allerdings funktioniert dieser nicht wenn Bereiche kopiert werden. Da der Vergleich nur anhand der ersten Zelle ausgewertet wird und nicht jede Zelle einzeln des kopierten Bereichs. :-(
Gruß Tom
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("f4:q500")) Is Nothing Then
Row = Target.Row
spalte = Target.Column
spalte1 = spalte + 30
range1 = Cells(Row, spalte)
range2 = Cells(Row, spalte1)
'If Not Intersect(Target, Range("rZellen")) Is Nothing Then
If range1 > range2 Then
Range("d" & Target.Row) = Date
Range("d" & Row).Font.ColorIndex = Sheets("Index").Range("b2").Font.ColorIndex
Target.Font.ColorIndex = Sheets("Index").Range("b2").Font.ColorIndex
Target.Copy
ActiveSheet.Paste Destination:=ActiveSheet.Cells(Row, spalte1)
Application.CutCopyMode = False
End If
End If
End Sub