Copy dữ liệu từ nhiều cột về 1 cột theo điều kiện dòng đầu tiên

[ndt1235]

Em có bảng dữ liệu như sheet 1 trong file mẫu đính kèm gồm 100 item.
E muốn sắp xếp lại các item theo dạng cột như sheet 2.
Mong mọi người giúp đỡ ạ...

Cảm ơn

 

[leonguyenz]

Tham khảo code sau:

Sub DaTr()
Dim iR As Long, jR As Long, kR As Long, Rng As Range
Dim mR As Long, nR As Long, rArr As Variant
Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion
ReDim rArr(1 To Rng.Rows.Count * Rng.Columns.Count, 1 To 6)
For iR = 1 To Rng.Columns.Count
    If Rng(1, iR) <> "" And Rng(3, iR) <> "" Then
    nR = Sheets("Sheet1").Cells(65535, iR).End(3).Row
    For jR = 3 To nR
        If Rng(jR, iR) <> "" Then
            mR = mR + 1
            rArr(mR, 1) = Rng(1, iR)
            For kR = 1 To 5
                rArr(mR, kR + 1) = Rng(jR, iR + kR - 1)
            Next kR
        End If
    Next jR
    End If
Next iR
If mR Then
    Sheets("Sheet2").Range("A2:F65535").ClearContents
    Sheets("Sheet2").Range("A2:F2").Resize(mR) = rArr
End If
End Sub