Copy cột thành dòng

[dungvovan]

Đoạn code trong file khi chạy sẽ copy bảng dử liệu đã có thành 1 bảng mới có cấu trúc như bảng nguồn .
Bây giờ Tôi muốn copy lại thành 1 bảng có data nối tiếp vào nhau chỉ gồm 2 cột STT và tên khách hàng thôi .
Xin hỏi các Anh - Chị Tôi phải sửa đoạn code trên như thế nào ?( Xem file đính kèm )
Cám ơn các Anh - Chị .

 

[SA_DQ]

Macro đề xuất như sau:

Option Explicit
Sub ChepCot()
 Dim lrow As Long, eRow As Long
 Dim bF As Byte, lCol As Byte
 
 lCol = [Iv2].End(xlToLeft).Column
 MsgBox lCol
 For bF = 4 To lCol Step 2
   lrow = [b65432].End(xlUp).Row + 1
   Range(Cells(3, bF), Cells(65432, bF).End(xlUp)).Copy _
      Destination:=Cells(lrow, "B")
   Cells(lrow, "b").Interior.ColorIndex = 33 + (bF Mod 4)
 Next bF
End Sub

Quả tình thấy macro bạn viết mình đã chết kiếp rồi!!

 

[dungvovan]

Chào bạn HYen
Bạn cười mình củng phải
Cảm ơn bạn nhiều
í...
Mà sao nó ko chạy vậy ta ...
Cám ơn Anh Thunghi

 

[ThuNghi]

Đoạn code trong file khi chạy sẽ copy bảng dử liệu đã có thành 1 bảng mới có cấu trúc như bảng nguồn .
Bây giờ Tôi muốn copy lại thành 1 bảng có data nối tiếp vào nhau chỉ gồm 2 cột STT và tên khách hàng thôi .
Xin hỏi các Anh - Chị Tôi phải sửa đoạn code trên như thế nào ?( Xem file đính kèm )
Cám ơn các Anh - Chị .

Tôi làm lại 1 code, chép toàn bộ vào Sh Data

Sub CopyData()
Dim eCol As Long, eRow As Long, iRow As Long

Sheets("data").Select
Range("A2:B10000").ClearContents
With Sheets("Test")
    eCol = .[IV1].End(xlToLeft).Column 'cot cuoi co du lieu
    For i = 2 To eCol Step 2
        eRow = .[A65000].Offset(, i - 1).End(xlUp).Row 'dong cuoi co du lieu cot i
        iRow = [A65000].End(xlUp).Row + 1 'dong cuoi co du lieu cot A +1
        Range("A" & iRow & ":B" & iRow + eRow - 3).Value = .Range("A3:B" & eRow).Offset(, i - 2).Value
    Next
End With
End Sub