ditimdl
Thành viên thường trực
- Tham gia
- 11/10/06
- Bài viết
- 378
- Được thích
- 107
- Giới tính
- Nam
- Nghề nghiệp
- Pharmacist
Gửi các bạn!
Mình có sưu tầm 1 đoạn code của bạn dhn46 trên diễn đàn GPE để lấy dữ liệu từ 1 sheet của file đang đóng và cho vào 1 sheet của file đang mở, code hoạt động tốt. Tuy nhiên, do nhu cầu công việc nên mình muốn lấy dữ liệu nhiều sheet của 1 file đang đóng cho vào nhiều sheet của file đang mở nhưng mình không biết chỉnh sửa thế nào cho đúng.
(Nếu thực hiện code này nhiều lần thì vẫn cho kết quả như mình mong muốn nhưng như vậy sẽ mất nhiều thời gian cho thao tác chọn file để mở)
Mong các bạn giúp đỡ!
Mình có sưu tầm 1 đoạn code của bạn dhn46 trên diễn đàn GPE để lấy dữ liệu từ 1 sheet của file đang đóng và cho vào 1 sheet của file đang mở, code hoạt động tốt. Tuy nhiên, do nhu cầu công việc nên mình muốn lấy dữ liệu nhiều sheet của 1 file đang đóng cho vào nhiều sheet của file đang mở nhưng mình không biết chỉnh sửa thế nào cho đúng.
(Nếu thực hiện code này nhiều lần thì vẫn cho kết quả như mình mong muốn nhưng như vậy sẽ mất nhiều thời gian cho thao tác chọn file để mở)
Mong các bạn giúp đỡ!
Mã:
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 [THONGKE$A1:AJ65536] WHERE f2 is not Null"
lrs.Open lsSQL, cnn, 3, 1
'Copy ket qua vao sheet Tong hop
Sheet2.Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
cnn.Close
Next
End With
Application.ScreenUpdating = True
Set lrs = Nothing
Set cnn = Nothing
End Sub