hücre değerine göre Farklı hücre biçimlendirme

[excellkurdu]

Merhaba arkadaşlar,
Aradım ama bulamadım. Belkide aramayı beceremedim.
Aşağıdaki kodu kullanıyorum. G sütununa "ok" yazınca sadece G sutunu renkleniyor.
Aynı biçimlendirmenin A-B-C-D-E-F sutunlarında da olmasını nasıl sağlayabiliriz.
Şimdiden teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
'---hücre renklendirme
On Error GoTo HATA
If Intersect(Target, [G1:G15000]) Is Nothing Then Exit Sub
If Target = "ok" Then Target.Interior.ColorIndex = 6
If Target = "" Then Target.Interior.ColorIndex = 0
HATA:
End Sub

 

[çıtır]

Private Sub Worksheet_Change(ByVal Target As Range)
'---hücre renklendirme
On Error GoTo HATA
If Intersect(Target, [A1:G15000]) Is Nothing Then Exit Sub
If Target = "ok" Then Target.Interior.ColorIndex = 6
If Target = "" Then Target.Interior.ColorIndex = 0
HATA:
End Sub

 

[excellkurdu]

Private Sub Worksheet_Change(ByVal Target As Range)
'---hücre renklendirme
On Error GoTo HATA
If Intersect(Target, [A1:G15000]) Is Nothing Then Exit Sub
If Target = "ok" Then Target.Interior.ColorIndex = 6
If Target = "" Then Target.Interior.ColorIndex = 0
HATA:
End Sub

Hocam cevabınız için tşk ederim. Ama istediğim tam bu değil. Yine sadece "G" sutununda "ok" yazacağım. "ok" yazdığım yerin solundaki A-B-C-D-E-F sutunları aynen şuan var olan koddaki gibi SARI biçimlendirme olmalı. "ok" yazısını G sutunu haricinde hiç bir yerde kullanmıyorum.
Değiştirmek istediğim yer:

If Target = "ok" Then Target.Interior.ColorIndex = 6

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    '---hücre renklendirme
    On Error GoTo Hata
    If Intersect(Target, [G1:G15000]) Is Nothing Then Exit Sub
    If Target = "ok" Then Target.Offset(0, -6).Resize(1, 7).Interior.ColorIndex = 6
    If Target = "" Then Target.Offset(0, -6).Resize(1, 7).Interior.ColorIndex = 0
Hata:
End Sub

 

[çıtır]

Private Sub Worksheet_Change(ByVal Target As Range)
'---hücre renklendirme
On Error GoTo HATA
For i = 1 To 15000
If Intersect(Target, [g1:G15000]) Is Nothing Then Exit Sub
If Range("g" & i) = "ok" Then Range("a" & i & ":" & "g" & i).Interior.ColorIndex = 6
If Target = "" Then Target.Interior.ColorIndex = 0
Next i
HATA:
End Sub

 

[excellkurdu]

Korhan Hocam Çıtır Hocam çok sağolun. Bir kod ararken 2 kod verdiniz. Teşekkür ederim.
Yalnız Korhan Hocamın kodu yarı yarıya daha hızlı çalışıyor.
Tekrar sağolun emeğinize sağlık.