Chuyển nhiều cột thành 1 cột

[haup299]

Mình có vấn đề nhờ các bạn giúp đỡ.
Ví dụ mình có dữ liệu ở cột A, B, C
Bây giờ mình muốn chuyển cột B, C xuống dưới cột A (chỉ thành 1 cột A)
Nếu ít cột thì có thể copy paste nhưng có rất nhiều cột, copy rất lâu
Ngoài việc copy có thể sử dụng chức năng gì của ex để chuyển nhiều cột thành 1 cột không?

 

[phulien1902]

Mình có vấn đề nhờ các bạn giúp đỡ.
Ví dụ mình có dữ liệu ở cột A, B, C
Bây giờ mình muốn chuyển cột B, C xuống dưới cột A (chỉ thành 1 cột A)
Nếu ít cột thì có thể copy paste nhưng có rất nhiều cột, copy rất lâu
Ngoài việc copy có thể sử dụng chức năng gì của ex để chuyển nhiều cột thành 1 cột không?

Thử:

Sub abc()
    Dim a, b, c, k As Long
    a = Sheet1.Cells(1).CurrentRegion
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
    For Each c In a
        If c <> Empty Then
            k = k + 1
            b(k, 1) = c
        End If
    Next
    [A1].Resize(k) = b
    Columns("B:C").ClearContents
End Sub

+ Hoặc

Sub abc2()
    Dim LR As Long, LR1 As Long, LR2 As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    LR1 = Range("B" & Rows.Count).End(xlUp).Row
    Range("B1:B" & LR1).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    LR2 = Range("C" & Rows.Count).End(xlUp).Row
    Range("C1:C" & LR2).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    Columns("B:C").ClearContents
End Sub

 

[haup299]

Thử:

Sub abc()
    Dim a, b, c, k As Long
    a = Sheet1.Cells(1).CurrentRegion
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1)
    For Each c In a
        If c <> Empty Then
            k = k + 1
            b(k, 1) = c
        End If
    Next
    [A1].Resize(k) = b
    Columns("B:C").ClearContents
End Sub

+ Hoặc

Sub abc2()
    Dim LR As Long, LR1 As Long, LR2 As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    LR1 = Range("B" & Rows.Count).End(xlUp).Row
    Range("B1:B" & LR1).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    LR2 = Range("C" & Rows.Count).End(xlUp).Row
    Range("C1:C" & LR2).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
    Columns("B:C").ClearContents
End Sub

Cảm ơn bạn nhé