[Help] VBA Copy nối cột từ sheet này sang sheet khác

[robinhsoon]

Thân chào cả nhà GPEX!

Mong cả nhà giúp em một việc ạ.
Hiện tại em có data gồm 8 cột.. Em muốn dùng VBA copy nối cột từ sheet Data sang sheet kết quả.
Ví dụ: Copy cột A + B + C --> Sheet Ket qua Paste ở cột A,B,C
Copy cột A + B + D --> Sheet Ket qua Paste ở cột A,B,C
Copy cột A + B + E --> Sheet Ket qua Paste ở cột A,B,C
.....end.........
Em có làm kết quả ở trong File ạ.

Mong cả nhà giúp đỡ em ạ...!

 

[be_09]

Thân chào cả nhà GPEX!

Mong cả nhà giúp em một việc ạ.
Hiện tại em có data gồm 8 cột.. Em muốn dùng VBA copy nối cột từ sheet Data sang sheet kết quả.
Ví dụ: Copy cột A + B + C --> Sheet Ket qua Paste ở cột A,B,C
Copy cột A + B + D --> Sheet Ket qua Paste ở cột A,B,C
Copy cột A + B + E --> Sheet Ket qua Paste ở cột A,B,C
.....end.........
Em có làm kết quả ở trong File ạ.

Mong cả nhà giúp đỡ em ạ...!

Bạn giải thích chưa rỏ ràng, cụ thể, ví dụ:
1/ Copy A2: B6 hay dữ liệu cột A và B chứa bất kỳ (lúc nhiều, lúc ít) và Paste lặp xuống vào cột A, B, C của sheet2.
2/ Cụ thể mỗi lần copy lặp là:
- A2: B6 và C2: C6
- A2: B6 và D2: D6
- A2: B6 và E2: E6
- A2: B6 và F2: F6
- A2: B6 và G2: G6
- A2: B6 và H2: H6

 

[SA_DQ]

Macro của bạn đây & những mong là khỏi đưa file lên:

Sub CopyTheoCot()
 Dim Rg0 As Range, RgC As Range, dRg As Range
 Dim Rws As Long, Col As Integer, J As Integer

 Sheets("KetQua").[B2].CurrentRegion.Offset(1).ClearContents    'Xóa DL Cu  '
 Application.ScreenUpdating = False
 With Sheets("Data")
    Rws = .[B2].CurrentRegion.Rows.Count
    Set Rg0 = .Cells(2, 1).Resize(Rws, 2)
    For J = 3 To .[C1].End(xlToRight).Column
        Set dRg = Sheets("KetQua").[A65500].End(xlUp).Offset(1)
        Rg0.Copy Destination:=dRg
        .Cells(2, J).Resize(Rws).Copy Destination:=dRg.Offset(, 2)
    Next J
 End With
 Application.ScreenUpdating = True
 MsgBox "Xong Rôi!", , "GPE.COM Xin Thông Báo!"
End Sub

 

[robinhsoon]

Bạn giải thích chưa rỏ ràng, cụ thể, ví dụ:
1/ Copy A2: B6 hay dữ liệu cột A và B chứa bất kỳ (lúc nhiều, lúc ít) và Paste lặp xuống vào cột A, B, C của sheet2.
2/ Cụ thể mỗi lần copy lặp là:
- A2: B6 và C2: C6
- A2: B6 và D2: D6
- A2: B6 và E2: E6
- A2: B6 và F2: F6
- A2: B6 và G2: G6
- A2: B6 và H2: H6

Em Cảm ơn Anh đã giúp em giải thích rõ hơn ạ, Nhờ vậy các Thầy có thể giúp đỡ em dễ dàng và nhanh chóng hơn.. Chúc anh Sức khỏe và thành công ạ

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

Macro của bạn đây & những mong là khỏi đưa file lên:

Sub CopyTheoCot()
Dim Rg0 As Range, RgC As Range, dRg As Range
Dim Rws As Long, Col As Integer, J As Integer

Sheets("KetQua").[B2].CurrentRegion.Offset(1).ClearContents    'Xóa DL Cu  '
Application.ScreenUpdating = False
With Sheets("Data")
    Rws = .[B2].CurrentRegion.Rows.Count
    Set Rg0 = .Cells(2, 1).Resize(Rws, 2)
    For J = 3 To .[C1].End(xlToRight).Column
        Set dRg = Sheets("KetQua").[A65500].End(xlUp).Offset(1)
        Rg0.Copy Destination:=dRg
        .Cells(2, J).Resize(Rws).Copy Destination:=dRg.Offset(, 2)
    Next J
End With
Application.ScreenUpdating = True
MsgBox "Xong Rôi!", , "GPE.COM Xin Thông Báo!"
End Sub

Em cảm ơn Thầy ạ, code hay và hiệu quả lắm ạ.. Chúc Thầy sức khỏe và Thành công ạ