bedingte Formatierung mit VBA

[Kuwer]

Hallo Wolfgang,

teste mal damit:

Code:

Sub KreuzeReinRaus()
  Dim rngT As Range, rngZ As Range
  Dim lngE As Long
  lngE = Application.Match("Wochenliste in Datenbank übernommen", Columns(12))
  For Each rngT In Range("D6:Q6")
    If rngT.DisplayFormat.Interior.Color = 255 Then
      For Each rngZ In rngT.Offset(2).Resize(lngE - 8).Cells
        If rngZ.MergeCells Or Cells(rngZ.Row, 1).MergeCells Then
          With rngZ.Borders(xlDiagonalUp)
            .LineStyle = 1
            .Weight = xlMedium
            .Color = RGB(0, 0, 0)
          End With
          With rngZ.Borders(xlDiagonalDown)
            .LineStyle = 1
            .Weight = xlMedium
            .Color = RGB(0, 0, 0)
          End With
        End If
      Next rngZ
    Else
      With rngT.Offset(2).Resize(lngE - 8)
        .Borders(xlDiagonalUp).LineStyle = -4142
        .Borders(xlDiagonalDown).LineStyle = -4142
      End With
    End If
  Next rngT
End Sub

Gruß Uwe