önce çalışmanıza bir modül ekleyip aşağıdaki kodu yapıştırın

Option Compare Text



Function xRenk(ByVal Rng As Range) ' As String

    If Len(Rng.Value & "") > 0 Then Rng.Offset(, 1).Interior.Color = HEXCOL2RGB(Rng.Value) Else Rng.Offset(, 1).Interior.Color = vbWhite

End Function



Public Function HEXCOL2RGB(ByVal HexColor As String) As String

Dim Red As String, Green As String, Blue As String

    HexColor = Replace(HexColor, "#", "")

    Red = Val("&H" & Mid(HexColor, 1, 2))

    Green = Val("&H" & Mid(HexColor, 3, 2))

    Blue = Val("&H" & Mid(HexColor, 5, 2))

HEXCOL2RGB = RGB(Red, Green, Blue)

End Function

sonrada ilgili sayfanın olayını aşağıdaki gibi düzenleyin

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A:A")) Is Nothing Then 'sadece B,C sütununa bakar

Application.EnableEvents = False

    On Error GoTo hata

    Dim cll As Range

    AdrX = Target.Address & ":" & Target.Address

    xDz = Split(AdrX, "$")

    ilk = xDz(2)

    Son = Val(xDz(4))

    If ilk = "1:" Then ilk = "2:"

    If Son < 2 Then Son = 2

    Set Trgt = Range("A" & ilk & "A" & Son)



    For Each cll In Trgt

        Set Rng = cll

        xRenk (Rng)

    Next cll



End If

hata:

Application.EnableEvents = True

End Sub

dilerim işinize yarar