Option Explicit
Sub lay_DL()
Dim k As Long, r As Long, count As Long, sheetnames, dulieu(), kq()
ThisWorkbook.Worksheets("sheet55").Range("A3:D1000").ClearContents
sheetnames = Array("sheet1", "sheet4", "sheet6")
ReDim kq(1 To 10000, 1 To 5)
For k = 0 To UBound(sheetnames)
With ThisWorkbook.Worksheets(sheetnames(k))
dulieu = .Range("A5:F" & .Cells(Rows.count, "C").End(xlUp).Row + 1).Value
End With
For r = 1 To UBound(dulieu, 1) - 1
If Len(dulieu(r, 3)) Then
count = count + 1
kq(count, 1) = dulieu(r, 1)
kq(count, 2) = dulieu(r, 3)
kq(count, 3) = dulieu(r, 4)
kq(count, 4) = dulieu(r, 6)
If Len(dulieu(r, 5)) Then
kq(count, 5) = dulieu(r, 5)
Else
kq(count, 5) = kq(count - 1, 5)
End If
End If
Next r
Next k
If count = 0 Then Exit Sub
With ThisWorkbook.Worksheets("sheet55").Range("A3:E3").Resize(count)
.Value = kq
.Sort Key1:=.Offset(0, 4).Resize(, 1), Order1:=xlAscending
.Offset(0, 4).Resize(, 1).ClearContents
kq = .Value
End With
k = 0
For r = 1 To UBound(kq, 1)
If Len(kq(r, 1)) Then
k = k + 1
kq(r, 1) = k
End If
Next r
ThisWorkbook.Worksheets("sheet55").Range("A3").Resize(UBound(kq, 1)).Value = kq
End Sub
