Farklı Sayfa veri Girişine Göre Koşullu Biçimlendirme

[Feylosof]

Değerli Excel dostları,
İkinci Sayfadaki hücrelere veri girildikçe birinci sayfada o hücreye denk gelen hücre renklenecek. Ve eğer mümkünse vba kodu ile olursa çok minnettar olacağım. Örnek dosyayı yükledim. Detaylı bilgi mevcuttur.
Şimdiden teşekkürler.

Hata indir

Hata

www.dosyaupload.com

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range
    If Intersect(Target, Range("C6:L30")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then
        For Each Alan In Selection
            If Not Intersect(Alan, Range("C6:L30")) Is Nothing Then
                If Alan <> "" Then
                    Sheets("Sayfa1").Range(Alan.Address).Interior.ColorIndex = 15
                Else
                    Sheets("Sayfa1").Range(Alan.Address).Interior.ColorIndex = xlNone
                End If
            End If
        Next
    Else
        If Target <> "" Then
            Sheets("Sayfa1").Range(Target.Address).Interior.ColorIndex = 15
        Else
            Sheets("Sayfa1").Range(Target.Address).Interior.ColorIndex = xlNone
        End If
    End If
End Sub

 

[Feylosof]

Değerli Üstadım çok teşekkür ediyorum. Duacınızım.

 

[Feylosof]

Korhan Hocam @Korhan Ayhan bir sorum daha olacak. Soruyu tersinden düşünüp sormak istiyorum. Sayfa2 de ilgili veriler boşken sayfa1 renklense ve Sayfa 2 hücrelerine veri girildikçe Sayfa 1 deki hücrelerin rengi beyaza dönse bu durumda kod nasıl olmalı?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Veri As Range
    Set Alan = Range("C6:L30")
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
    Sheets("Sayfa1").Range("C6:L30").Interior.ColorIndex = 15
    For Each Veri In Alan
        If Not Intersect(Veri, Alan) Is Nothing Then
            If Veri <> "" Then
                Sheets("Sayfa1").Range(Veri.Address).Interior.ColorIndex = xlNone
            Else
                Sheets("Sayfa1").Range(Veri.Address).Interior.ColorIndex = 15
            End If
        End If
    Next
End Sub

 

[Feylosof]

Sayın Üstadım. Çok teşekkür ediyorum. Bu dosyada epey yol aldıracak. Elinize emeğinize sağlık...