Copy từ sheet này sang sheet khác

[hcl_pt]

Mình có file dữ liệu cần copy dữ liệu từ sheet này sang sheet khác theo mã. Mong GPE giúp đỡ như sau:
Dữ liệu ở sheet(CSDL) có 4 cột A,B, C, D có chứa các mã dữ liệu.
Sheet(MA_COPY) cũng có 4 cột A, B, C, D chứa các mã dữ liệu cần copy tương ứng.
Cần copy tất cả các dòng dữ liệu ở sheet(CSDL) có cùng mã với mã ở sheet(MA_COPY):
+ Tất cả dòng dữ liệu có chứa mã ở cột A trong sheet(CSDL) trùng với mã cần copy ở cột A trong sheet(MA_COPY) được copy kết quả dán vào sheet(A)
+ Tất cả dòng dữ liệu có chứa mã ở cột B trong sheet(CSDL) trùng với mã cần copy ở cột B trong sheet(MA_COPY) được copy kết quả dán vào sheet(B)
+ Tất cả dòng dữ liệu có chứa mã ở cột C trong sheet(CSDL) trùng với mã cần copy ở cột A trong sheet(MA_COPY) được copy kết quả dán vào sheet(C)
+ Tất cả dòng dữ liệu có chứa mã ở cột D trong sheet(CSDL) trùng với mã cần copy ở cột D trong sheet(MA_COPY) được copy kết quả dán vào sheet(D)
Mình có gửi kèm theo file minh hoạ. Mong sự giúp đỡ của các bạn. Xin trân trọng cảm ơn!

 

[huuthang_bd]

Mình có file dữ liệu cần copy dữ liệu từ sheet này sang sheet khác theo mã. Mong GPE giúp đỡ như sau:
Dữ liệu ở sheet(CSDL) có 4 cột A,B, C, D có chứa các mã dữ liệu.
Sheet(MA_COPY) cũng có 4 cột A, B, C, D chứa các mã dữ liệu cần copy tương ứng.
Cần copy tất cả các dòng dữ liệu ở sheet(CSDL) có cùng mã với mã ở sheet(MA_COPY):
+ Tất cả dòng dữ liệu có chứa mã ở cột A trong sheet(CSDL) trùng với mã cần copy ở cột A trong sheet(MA_COPY) được copy kết quả dán vào sheet(A)
+ Tất cả dòng dữ liệu có chứa mã ở cột B trong sheet(CSDL) trùng với mã cần copy ở cột B trong sheet(MA_COPY) được copy kết quả dán vào sheet(B)
+ Tất cả dòng dữ liệu có chứa mã ở cột C trong sheet(CSDL) trùng với mã cần copy ở cột A trong sheet(MA_COPY) được copy kết quả dán vào sheet(C)
+ Tất cả dòng dữ liệu có chứa mã ở cột D trong sheet(CSDL) trùng với mã cần copy ở cột D trong sheet(MA_COPY) được copy kết quả dán vào sheet(D)
Mình có gửi kèm theo file minh hoạ. Mong sự giúp đỡ của các bạn. Xin trân trọng cảm ơn!

Nhiều người thắc mắc về mục đích của bạn nhưng bạn không trả lời. Bạn không muốn tiết lộ những gì bạn đang làm thì tôi cũng thế

 

[huuthang_bd]

Chia sẽ code đi đại ka Huuthang_bd. Cho anh em còn học hỏi chứ. (mà ai thắc mắc chủ topic cũng kệ đi.) share cho anh em học hỏi nhé... Cảm ơn!

Vì thấy chủ topic làm việc mờ ám quá. Anh em hỏi hoài mà cứ im như thóc. Cũng chả thèm nói lý do không thể nói rõ mục đích

Sub GetData()
Const DataSheetName As String = "CSDL", FirstRow As Long = 4
Dim Cnn As Object, Rst As Object, EndRow As Long, i As Long, j As Long, CritArr As Variant, CritStr As String
    EndRow = Sheets(DataSheetName).Cells(&H10000, 1).End(xlUp).Row
    If EndRow < FirstRow Then Exit Sub
    Range(Sheets(DataSheetName).Cells(FirstRow, 5), Sheets(DataSheetName).Cells(EndRow, 11)).NumberFormat = "@"
    CritArr = Range(Sheets("MA").Cells(4, 4), Sheets("MA").Cells(&H10000, 1).End(xlUp)).Value
    Set Cnn = CreateObject("ADODB.Connection")
    Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No"";"
    For i = 1 To 4
        Sheets(ChrW(64 + i)).Range("A4:K65536").ClearContents
        CritStr = ""
        For j = 1 To UBound(CritArr, 1)
            If CritArr(j, i) <> "" Then CritStr = CritStr & " OR F" & i & " = " & CritArr(j, i)
        Next
        If Len(CritStr) > 0 Then
            CritStr = Mid(CritStr, 5)
            Set Rst = Cnn.Execute("Select * From [" & DataSheetName & "$A" & FirstRow & ":K" & EndRow & "] Where " & CritStr)
            Sheets(ChrW(64 + i)).Cells(4, 1).CopyFromRecordset Rst
            Set Rst = Nothing
        End If
    Next
    Set Cnn = Nothing
End Sub