Option Explicit
Sub SoDuLieu()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim MyAdd As String: Dim Color_ As Byte
Sheet2.Select: Set Sh = Sheet1
Set Rng = Sh.Range(Sh.[G1], Sh.[g65500].End(xlUp))
For Each Cls In Range([G2], [g65500].End(xlUp))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
With sRng
If .Offset(, -6).Value = Cls.Offset(, -6).Value And .Offset(, -5).Value = Cls.Offset(, -5).Value _
And .Offset(, -4).Value = Cls.Offset(, -4).Value And .Offset(, -3).Value = Cls.Offset(, -3).Value _
And .Offset(, -2).Value = Cls.Offset(, -2).Value And .Offset(, -1).Value = Cls.Offset(, -1).Value _
Then
Cls.Offset(, 1).Value = "OK": Color_ = 34 + Cls.Row Mod 6
Cls.Interior.ColorIndex = Color_: sRng.Interior.ColorIndex = Color_
End If
Set sRng = Rng.FindNext(sRng)
End With
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next Cls
End Sub
thehungqnu 
