Sub test()
Dim p1 As Range, p2 As Range, c1 As Range, c2 As Range, c3 As Range, p3 As Range, masomme As Integer
Application.ScreenUpdating = False
For Each c1 In Range("B4:K25")
For Each c2 In Range("B27:G38")
For Each c3 In Range("B40:K44")
If c1.Value = c2.Value Then c1.Interior.ColorIndex = c2.Interior.ColorIndex: Exit For
If c3.Value = c2.Value Then c3.Interior.ColorIndex = c2.Interior.ColorIndex: Exit For
Next c3
Next c2
Next c1
For Each c1 In Range("L4:L25")
masomme = 0
For Each c2 In Range(c1.Offset(0, -10), c1.Offset(0, -1))
If c2.Interior.ColorIndex <> xlNone Then masomme = masomme + 1
Next c2
c1.Value = masomme
Next c1
Application.ScreenUpdating = True
End Sub