Betinget formatering hvis celle aktiv

Det kan gøres på flere måder, her er en af dem... koden skal ligge bagved arket - højreklik på fanen og vælg "vis kode"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B1")) Is Nothing Then
        Range("B2").Interior.Color = vbYellow
        Range("B3").Interior.Color = vbYellow
    Else
        Range("B2").Interior.Color = xlNone
        Range("B3").Interior.Color = xlNone
    End If
End Sub

Mange tak Flemming Vadet, det virker perfekt, men nu bliver jeg meget krævende :-)
Jeg vil gerne have at når jeg står i B1 så farves B2 og B3 (det virker), når jeg står i E1 så farves E2 og E3, når jeg står i F1 så farves F2 og F3

Kun de 3 kolonner eller gælder det altid når du markerer en celle i række 1 ?

Jeg løste det ved at sætte dem ind efter hinanden, det virker :-)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Unprotect
    If Not Intersect(Target, Range("B1")) Is Nothing Then
        Range("B2").Interior.Color = vbYellow
        Range("B3").Interior.Color = vbYellow
    Else
        Range("B2").Interior.Color = xlNone
      Range("B3").Interior.Color = xlNone
    End If
        If Not Intersect(Target, Range("E1")) Is Nothing Then
        Range("E2").Interior.Color = vbYellow
    Else
        Range("E2").Interior.Color = xlNone
        Range("E3").Interior.Color = xlNone
    End If
        If Not Intersect(Target, Range("F1")) Is Nothing Then
        Range("F2").Interior.Color = vbYellow
        Range("F3").Interior.Color = vbYellow
    Else
        Range("F2").Interior.Color = xlNone
        Range("F2").Interior.Color = xlNone
    End If
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
End Sub

Og den kort version, hvor du nemt kan tilføje en celle i Union'en...

Public rCurCell As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rReactOn As Range
   
    If rCurCell Is Nothing Then Set rCurCell = Target
    Set rReactOn = Union(Range("B1"), Range("E1"), Range("F1"))
    If Not Intersect(rCurCell, rReactOn) Is Nothing Then
        rCurCell.Offset(1, 0).Interior.Color = xlNone
        rCurCell.Offset(2, 0).Interior.Color = xlNone
    End If
   
    If Not Intersect(Target, rReactOn) Is Nothing Then
        Target.Offset(1, 0).Interior.Color = vbYellow
        Target.Offset(2, 0).Interior.Color = vbYellow
    End If
    Set rCurCell = Target
End Sub

Mange tak Flemming den er mere elegant