Sub HintergrundfarbeAnpassen()
Range("x1").Select
Do Until ActiveCell.Address = "$X$15"
ActiveCell.Interior.ColorIndex = ActiveCell.Offset(0, -23).Interior.ColorIndex
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells(1, "X").Interior.ColorIndex = Cells(1, "A").Interior.ColorIndex
End Sub
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'dein Bereich der Gültigkeit
If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
Cancel = True
Application.Dialogs(84).Show
'deine Zelle X 10 Spalten weiter nach Rechts
Target.Offset(, 10).Interior.ColorIndex = Target.Interior.ColorIndex
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static lastRange As Range
' Bereich der Gültigkeit
If Not Intersect(Target, Range("A1:B10")) Is Nothing Then
If Not lastRange Is Nothing Then
' Farbzwillings-Zelle
lastRange.Offset(, 10).Interior.ColorIndex = lastRange.Interior.ColorIndex
End If
Set lastRange = Target
End If
End Sub