Nối (liên tục) 2 danh sách thành 01 danh sách (1 người xem)

[AnhThu-1976]

Chào các anh chị!
Tôi đã tìm trên diễn đàn nhưng kg thấy code nào giống như yêu cầu nên nhờ các anh chị cho đoạn code để nối 02 danh sách thành 01 danh sách
yêu cầu có ghi trong file
cảm ơn anh chị

 

[phihndhsp]

Dạng này trên diễn đàn có đầy đó chứ. Cách đơn giản nhất là copy và paste, nhớ trước khi copy và paste thì xoá dữ liệu cột kết quả đi. Cách làm tìm dòng cuối của mỗi bên sau đó copy bên 1 trước, và copy bên 2 bỏ xuống dưới dựa vào dòng cuối

 

[khongnhienttt]

mình thấy nên cho nó vào mảng thì sẽ duyệt nhanh hơn

 

[AnhThu-1976]

Dạng này trên diễn đàn có đầy đó chứ. Cách đơn giản nhất là copy và paste, nhớ trước khi copy và paste thì xoá dữ liệu cột kết quả đi. Cách làm tìm dòng cuối của mỗi bên sau đó copy bên 1 trước, và copy bên 2 bỏ xuống dưới dựa vào dòng cuối

Tôi cũng đang làm như bạn chỉ dẫn nhưng cuối cùng kết quả chỉ dán 1 cột
Không biết bị sai chỗ nào nhờ các bạn hướng dẫn

Sub NoiDuLieu()
Application.ScreenUpdating = False
Dim R1 As Long, R2 As Long, Rng1 As Range, Rng As Range
[I2:J65000].ClearContents


    Set Rng1 = Range([C2], [C65000].End(xlUp)).Resize(, 1)
    'MsgBox Rng1
    R1 = Rng1.Rows.Count


    [I2].Resize(R1, 1).Value = Rng1.Value


    Set Rng2 = Range([F2], [F65000].End(xlUp)).Resize(, 1)
    R2 = Rng2.Rows.Count


    [I65000].End(xlUp).Offset(1).Resize(R2, 1).Value = Rng2.Value
Set Rng1 = Nothing
Set Rng2 = Nothing
Application.ScreenUpdating = True
    
End Sub

Cảm ơn các bạn

 

[belukn]

Tôi cũng đang làm như bạn chỉ dẫn nhưng cuối cùng kết quả chỉ dán 1 cột
Không biết bị sai chỗ nào nhờ các bạn hướng dẫn

Sub NoiDuLieu()
Application.ScreenUpdating = False
Dim R1 As Long, R2 As Long, Rng1 As Range, Rng As Range
[I2:J65000].ClearContents


    Set Rng1 = Range([C2], [C65000].End(xlUp)).Resize(, 1)
    'MsgBox Rng1
    R1 = Rng1.Rows.Count


    [I2].Resize(R1, [SIZE=5][COLOR=#ff0000]2[/COLOR][/SIZE]).Value = Rng1.Value


    Set Rng2 = Range([F2], [F65000].End(xlUp)).Resize(, 1)
    R2 = Rng2.Rows.Count


    [I65000].End(xlUp).Offset(1).Resize(R2, [COLOR=#ff0000][SIZE=5]2[/SIZE][/COLOR]).Value = Rng2.Value
Set Rng1 = Nothing
Set Rng2 = Nothing
Application.ScreenUpdating = True
    
End Sub

Cảm ơn các bạn

Chỗ đỏ đỏ là mới sửa lại!

 

[SA_DQ]

Cũng chả cần fải đao to búa nhớn làm gì!

Sub Copy2Tables()
 [I2].CurrentRegion.Offset(1).ClearContents
 With [i65500].End(xlUp)
    [c2].CurrentRegion.Offset(1).Copy Destination:=.Offset(1)
 End With
 With [i65500].End(xlUp)
    [f2].CurrentRegion.Offset(1).Copy Destination:=.Offset(1)
 End With
End Sub