Hỏi cách chèn dữ liệu từ file khác (1 người xem)

[vutienloc99]

Chào các Anh/Chị
E có dữ liệu nguồn từ file DATA như sau:

Nay e muốn chèn dữ liệu tự động vào file tổng hợp như sau:

2 file này để chung thư mục
Khi chạy code VBA thì dữ liệu các cột Mã NV, Họ tên, Phòng ,Chức vụ, HSL, Giờ chấm công ở file tổng hợp được thay thế bằng dữ liệu mới từ file DATA.
Cảm ơn Anh/Chị.

 

[dhn46]

Bạn Copy code sau vào 1 module sau đó chạy Code nhé

Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object, Fname
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    Application.ScreenUpdating = False
    'Mo hop thoai chon file
    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, "DHN46 - Thong bao"
            Exit Sub
        End If
        'Duyet qua cac file duoc chon
        For Each Fname In .SelectedItems
            'Tao ket noi CSDL
            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
            End With
            'Cau lenh truy van
            lsSQL = "SELECT * FROM [TongHopChamCong$A4:F65536] WHERE f1 is not Null"
            lrs.Open lsSQL, cnn, 3, 1
            'Copy ket qua vao sheet Tong hop
            Sheets("TongHopChamCong").[A4:F65536].ClearContents
            Sheets("TongHopChamCong").Range("A4").CopyFromRecordset lrs
            cnn.Close
        Next
    End With
    Application.ScreenUpdating = True
    Set lrs = Nothing
    Set cnn = Nothing
End Sub

 

[vutienloc99]

Cảm ơn Bác rất nhiều, code chạy tốt, làm phiền Bác xíu nữa, e muốn lọc chỉ lấy Phòng Kế toán thì sửa câu truy vấn lại thế nào. Thanks

 

[dhn46]

Cảm ơn Bác rất nhiều, code chạy tốt, làm phiền Bác xíu nữa, e muốn lọc chỉ lấy Phòng Kế toán thì sửa câu truy vấn lại thế nào. Thanks

Bạn gõ chữ Kế toán vào ô A1 rồi dùng truy vấn sau

            'Cau lenh truy van
            lsSQL = "SELECT * FROM [TongHopChamCong$A4:F65536] WHERE f3='" & [COLOR=#ff0000][B][A1][/B][/COLOR] & "'"