Nhờ anh chị chỉnh sửa giúp đoạn code tổng hợp dữ liệu từ file đóng..

[shnhatha221108]

Em muốn tổng hợp dữ liệu từ nhiều file vào một file "TH" chứa các sheet tương ứng MS1,MS2
Mong anh chị em giải pháp chỉnh sửa giúp đoạn code:

Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Dim Fso As Object, Link As String, shNameNguon, shNameDich, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    shNameNguon = Array("NGAY_1", "NGAY_2")
    shNameDich = Array("MS1", "MS2")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thong Bao"
            Exit Sub
        End If
 
        For Each Fname In .SelectedItems
   
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
     
            For i = 0 To UBound(shNameNguon)
   
                lsSQL = "SELECT * FROM [" & shNameNguon(i) & "$A3:W10000]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets(shNameDich(i)).Range("A6:W50000").ClearContents
                Sheets(shNameDich(i)).Range("B50000").End(3).Offset(1, 0).CopyFromRecordset lrs
                lrs.Close
            Next
            End With
        Next
    End With
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub

 

[Maika8008]

Code lấy ở đâu đấy bạn? Chạy sai chỗ nào mà nhờ sửa?

 

[shnhatha221108]

Code lấy ở đâu đấy bạn? Chạy sai chỗ nào mà nhờ sửa?

Dạ..!code em tham khảo trên diễn đàn mình.!Code chạy không sai nhưng e chỉ tổng hợp được dữ liệu 1 file
Theo em hiểu .AllowMultiSelect = True cho phép chọn nhiều file nhưng khi chạy code thì chỉ tổng hợp được 1 file thôi..
Em muốn tổng hợp dữ liệu của cả 3 file vào một file TH..
Xin nhờ giúp đỡ ạ...!

 

[Maika8008]

Dạ..!code em tham khảo trên diễn đàn mình.!Code chạy không sai nhưng e chỉ tổng hợp được dữ liệu 1 file
Theo em hiểu .AllowMultiSelect = True cho phép chọn nhiều file nhưng khi chạy code thì chỉ tổng hợp được 1 file thôi..
Em muốn tổng hợp dữ liệu của cả 3 file vào một file TH..
Xin nhờ giúp đỡ ạ...!

Tôi giúp bạn tự kiểm tra tại sao chỉ lấy dữ liệu được từ 1 file:
bạn đặt con nháy vào dòng For Each Fname In .SelectedItems rồi bấm F9
Chạy code, sẽ ngừng ở dòng đã bấm F9 trên, từ đây bấm F8 để đi từng bước: trỏ chuột vào các biến, lật qua trang tính xem kết quả từng khâu trung gian, xem sai chỗ nào.

 

[shnhatha221108]

Tôi giúp bạn tự kiểm tra tại sao chỉ lấy dữ liệu được từ 1 file:
bạn đặt con nháy vào dòng For Each Fname In .SelectedItems rồi bấm F9
Chạy code, sẽ ngừng ở dòng đã bấm F9 trên, từ đây bấm F8 để đi từng bước: trỏ chuột vào các biến, lật qua trang tính xem kết quả từng khâu trung gian, xem sai chỗ nào.

Chào bạn Maika8008 mình đã thử kiểm tra...Lỗi phát sinh khi kết nối ghi dữ liệu xong file thứ nhất,tại vòng lặp For each kết nối dữ liệu đường link file thứ 2 thất bại nhưng không biết rõ lý do...
Thực sự thì mình biết về macro quá ít,chỉ tham khảo code của anh chị em trên mạng để áp dụng trong công việc được tốt hơn..
Thực sự rất mong bạn và anh chị em chỉ bảo..!

​