Makro İle Koşullu Biçimlendirme

[halilibo92]

Merhaba

B sütunundaki veriye göre diğer sütunları renklendirmek istiyorum bir şeyler karaladım ama kod çalışmıyor yardımlarınızı bekliyorum. Şimdiden teşekkürler.
Kod:

Private Sub Worksheet_Renk(ByVal Hucre As Range)
On Error GoTo son
If Intersect(Hucre, [b:b]) Is Nothing Then Exit Sub
ActiveSheet.Unprotect
If Hucre.Value = 0 Then
    With Range("B" & ActiveCell.Row, "C" & ActiveCell.Row, "D" & ActiveCell.Row, "E" & ActiveCell.Row, "F" & ActiveCell.Row, "G" & ActiveCell.Row, "H" & ActiveCell.Row, "I" & ActiveCell.Row).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    ActiveSheet.Protect
ElseIf Hucre.Value = "1-ALAN" Then
    With Range("F" & ActiveCell.Row, "H" & ActiveCell.Row, "I" & ActiveCell.Row).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Range("B" & ActiveCell.Row, "C" & ActiveCell.Row, "D" & ActiveCell.Row, "E" & ActiveCell.Row, "G" & ActiveCell.Row).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
ActiveSheet.Protect
End If
son:
End Sub

Düzenleme:
Aynı sayfadaki farklı bir kod ile çakışıyormuş. İki kodu birleştirince düzeldi.