Optiion Explicit
[B]Sub CopyAll()[/B]
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Rg0 As Range, Cll As Range, SRg As Range
Dim MyAdd As String
Sheets("DuToan").Select
Set Sh = ThisWorkbook.Worksheets("DGCT")
Sh.[C65500].End(xlUp).Offset(1, -1).Value = "GPE"
Set Rng = Sh.Range(Sh.[B7], Sh.[B65500].End(xlUp))
[f8].Resize(9 * Rng.Rows.Count, 7).ClearContents
For Each Cls In Range([b8], [b8].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
Set Rg0 = Sh.Range(sRng, sRng.End(xlDown).Offset(-1)).Offset(, 2)
For Each Cll In Sh.Range("MCV")
Set SRg = Rg0.Find(Cll.Value)
If Not SRg Is Nothing Then
Cls.Offset(, 5 + Cll.Row).Value = SRg.Offset(, 4).Value
End If
Next Cll
Else
Cls.Interior.ColorIndex = 38
End If
Next Cls
Randomize
[f6].Resize(, 3).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
[B]End Sub[/B]