Sao chép dữ liệu từ nhiều cột vào một cột VBA (1 người xem)

[Kool_Kool]

Mình muốn sao chép dữ liệu từ nhiều cột vào một cột:
Mình đã làm được 4 cột A B C D như công thức bên dưới, giờ mình muốn điều chỉnh để them các côt E F G H vào thì cần sửa lại thế nào: Mong cả nhà giúp đỡ:

Sub Noi_Cot2()
Columns("O:O").Select
Selection.ClearContents
Dim Sarr(), item, Kq(1 To 65000, 1 To 1), k
Sarr = [A110000].Value
For Each item In Sarr
If item <> "" Then
k = k + 1
Kq(k, 1) = item
End If
Next
[O1].Resize(k) = Kq
End Sub

 

[LamNA]

Mình muốn sao chép dữ liệu từ nhiều cột vào một cột:
Mình đã làm được 4 cột A B C D như công thức bên dưới, giờ mình muốn điều chỉnh để them các côt E F G H vào thì cần sửa lại thế nào: Mong cả nhà giúp đỡ:

Sub Noi_Cot2()
Columns("O:O").Select
Selection.ClearContents
Dim Sarr(), item, Kq(1 To 65000, 1 To 1), k
Sarr = [A110000].Value
For Each item In Sarr
If item <> "" Then
k = k + 1
Kq(k, 1) = item
End If
Next
[O1].Resize(k) = Kq
End Sub

Bạn thay
Sarr = [A110000].Value thành Sarr = [A1:H10000].Value

 

[Lê Hồng Minh83]

Mình muốn sao chép dữ liệu từ nhiều cột vào một cột:
Mình đã làm được 4 cột A B C D như công thức bên dưới, giờ mình muốn điều chỉnh để them các côt E F G H vào thì cần sửa lại thế nào: Mong cả nhà giúp đỡ:

Sub Noi_Cot2()
Columns("O:O").Select
Selection.ClearContents
Dim Sarr(), item, Kq(1 To 65000, 1 To 1), k
Sarr = [A110000].Value
For Each item In Sarr
If item <> "" Then
k = k + 1
Kq(k, 1) = item
End If
Next
[O1].Resize(k) = Kq
End Sub

Bạn nên chỉ định sheet thì khi sử dụng phím tắt không bị lỗi, không phải lúc nào chạy code lại phải quay về sheet đó để nhấn nút
tham khảo

Sub Noi_Cot2()
    Dim Sarr(), item, Kq(1 To 65000, 1 To 1), k
    With Sheets("Sheet1")
    .Range("O1:O10000").ClearContents
    Sarr = .Range("A1:H10000").Value
    For Each item In Sarr
        If item <> "" Then
            k = k + 1
            Kq(k, 1) = item
        End If
    Next
    .Range("O1").Resize(k) = Kq
    End With
End Sub

 

[Kool_Kool]

Bạn thay
Sarr = [A110000].Value thành Sarr = [A1:H10000].Value

Vâng, Cám ơn bạn nhiều

Bài đã được tự động gộp: 4/4/19

Bạn nên chỉ định sheet thì khi sử dụng phím tắt không bị lỗi, không phải lúc nào chạy code lại phải quay về sheet đó để nhấn nút
tham khảo

Sub Noi_Cot2()
    Dim Sarr(), item, Kq(1 To 65000, 1 To 1), k
    With Sheets("Sheet1")
    .Range("O1:O10000").ClearContents
    Sarr = .Range("A1:H10000").Value
    For Each item In Sarr
        If item <> "" Then
            k = k + 1
            Kq(k, 1) = item
        End If
    Next
    .Range("O1").Resize(k) = Kq
    End With
End Sub

Cám ơn bạn.