Renklendirme kodunu satır aralığında yaptırmak

[Ömer]

Konuyu çok net anlayamadım maalesef.
Ek olarak M sütununu kullanmanıza gerek yok. Kodlarda kullanılmamıştır.

Bu şekilde deneyin.

Sub MukayeseKontrolü()
 
    Dim a As Range, c As Range, sat As Long, S2 As Worksheet, S3 As Worksheet
 
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("SONUÇ")
 
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select
    son = [H:J].Find("*", , , , xlByRows, xlPrevious).Row
    S3.Range("A2:D" & Rows.Count).Clear
 
    sat = 2
    For Each a In Range("H2:J" & son)
        If a.Value <> "" Then
            With S2.Range("B:B")
                Set c = .Find(a.Value, , xlValues, xlWhole)
                If Not c Is Nothing Then
                    S3.Cells(sat, "A") = sat - 1
                    S3.Cells(sat, "B") = S2.Cells(c.Row, "B")
                    S3.Cells(sat, "C") = S2.Cells(c.Row, "E")
                    S3.Cells(sat, "D") = Cells(a.Row, "D")
                    sat = sat + 1
                End If
            End With
        End If
    Next a
    Application.ScreenUpdating = True
 
End Sub

.

 

[EKREM1661]

(Sen yaparsında olmaz mı) Ömer hocam..! olağanüstü.. Söyleyecek bir şey kalmadı ve iyiliğini unutmayacağım. Teşekkürler, tüm hayatında sağlık ve başarılar diliyorum..