Copy dữ liệu từ 1 file data nhiều sheet sang file tổng hợp mà không cần mở file data (1 người xem)

[nguoixala]

Gửi các anh chị.
Em có vấn đề cần giúp đỡ.
Vì em cần phải tổng hợp dữ liệu từ 1 file data sang file tổng hợp
1. file data có nhiều sheet.
2. Copy dữ liệu có điều kiện

hiện tại em phải copy và Paste nhiều lần, vì file dữ liệu có rất nhiều sheet.
Mất nhiều thời gian, em mong các anh chị giúp đỡ.
Chi tiết em có mô tả trong fle Đính kèm

em cám ơn nhiều

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[doveandrose]

tôi rất hâm mộ bạn nào dịch được câu này sang tiếng Việt

Dua vao chu Class nay de lay A1, vi tri khong co dinh nhung chu "Class" co dinh chi co 1 chu torng sheet

 

[nguoixala]

xin lỗi, mình đã viết lại có dấu rồi

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[doveandrose]

Tôi tìm đỏ con mắt có thấy câu nào giống vậy ở #1 đâu nhỉ???

trong đây nè ...................

 

[nguoixala]

trong đây nè ...................

xin lỗi, mình đã viết lại có dấu rồi . Mong bạn giúp mình

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[doveandrose]

xin lỗi, mình đã viết lại có dấu rồi . Mong bạn giúp mình

bây giờ tôi đi ngủ , bạn có 12 tiếng để làm sao cho dữ liệu giống với file thật nhất , nếu sau đây 12 tiếng chưa có ai làm thì tôi làm , vì sau khi làm xong tôi không thích nghe câu : "dữ liệu thật của mình hơi khác 1 chút ...."

 

[nguoixala]

bây giờ tôi đi ngủ , bạn có 12 tiếng để làm sao cho dữ liệu giống với file thật nhất , nếu sau đây 12 tiếng chưa có ai làm thì tôi làm , vì sau khi làm xong tôi không thích nghe câu : "dữ liệu thật của mình hơi khác 1 chút ...."

Dữ liệu mình chỉ có như vậy. Mong bạn giúp mình
cám ơn bạn trước

quần áo trẻ em | quan ao tre em | quần áo sơ sinh | quần áo bé trai | quần áo bé gái | bodysuit carter | quan ao so sinh | quan ao tre em nhap khau

 

[doveandrose]

Dữ liệu mình chỉ có như vậy. Mong bạn giúp mình
cám ơn bạn trước

Public Sub hello()
Dim pFile, cn As Object, cat As Object, sheetname, rs As Object
Dim r As Long, k As Long, c As Byte, arr, dArr(1 To 100000, 1 To 5)
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
pFile = Application.GetOpenFilename("Excel Files *.xls* (*.xls*),")
If TypeName(pFile) = "String" Then
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & pFile & _
    ";Extended Properties=""Excel 12.0;HDR=NO;ReadOnly=True;IMEX=1;"";"
    cat.ActiveConnection = cn
    For Each sheetname In cat.tables
        If Right(sheetname.Name, 1) = "$" Or Right(sheetname.Name, 2) = "$'" Then
            Set rs = cn.Execute("select * from [" & sheetname.Name & "] " & _
            " where f4 = 'Class' or (f1 is not null and f2 is not null " & _
            " and f3 is not null and f4 is not null)")
            If Not rs.EOF Then
                arr = rs.getrows
                rs.Close
                For r = 2 To UBound(arr, 2) Step 1
                    k = k + 1
                    dArr(k, 1) = arr(4, 0)
                    For c = 0 To 3 Step 1
                        dArr(k, c + 2) = arr(c, r)
                    Next
                Next
            End If
        End If
    Next
    cn.Close
    Sheet1.Range("A2:E" & Sheet1.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 20).ClearContents
    If k > 0 Then Sheet1.Range("A2").Resize(k, 5).Value = dArr
End If
End Sub

 

[nguoixala]

Public Sub hello()
Dim pFile, cn As Object, cat As Object, sheetname, rs As Object
Dim r As Long, k As Long, c As Byte, arr, dArr(1 To 100000, 1 To 5)
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
pFile = Application.GetOpenFilename("Excel Files *.xls* (*.xls*),")
If TypeName(pFile) = "String" Then
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="