Option Explicit
Sub ThongKe()
 Dim eRw As Long:                       Dim sLot As String
 Dim Col As Byte, Dong As Byte
 Dim Rng As Range, Clls As Range
 Const Ngay As String = "NGAY":         Const Dem As String = "DEM"
 
 
 Col = [IV3].End(xlToLeft).Column
 eRw = [b4].End(xlDown).Row
 Range(Cells(eRw + 2, "B"), Cells(9 * eRw, "I")).Clear
 Union(Cells(eRw + 3, "C"), Cells(eRw + 3, "G")).Value = "LOT"
 Cells(eRw + 3, "E") = Ngay:            Cells(eRw + 3, "I") = Dem
 Set Rng = [b4].CurrentRegion.SpecialCells(xlCellTypeConstants, 1)
 For Each Clls In Rng
    If sLot = "" Or sLot <> Cells(Clls.Row, "B").Value Then
        sLot = Cells(Clls.Row, "B").Value
        Dong = 1
    Else
        Dong = 0
    End If
    With [C65500].End(xlUp).Offset(1 + Dong)
        If Cells(3, Clls.Column) = Ngay Then
            .Value = sLot
            .Offset(, 1) = Cells(2, Clls.Column).Value
            .Offset(, 2) = Clls.Value
        Else
            .Offset(-1, 4) = sLot
            .Offset(-1, 5) = Cells(2, Clls.Column).Value
            .Offset(-1, 6) = Clls.Value
        End If
    End With    
 Next Clls
End Sub