Book1 và Book2 không cần mở các bạn nhé. Giúp mình một code trong workbook sosanh để có thể update dữ liệu trong các workbook khácMình có 3 workbook: book1.xls, book2.xls, sosanh.xls
Giờ mình muốn tổng hợp 2 workbook 1 và 2 vào sheet VSD của workbook sosanh
Nhờ các anh chị viết giúp một đoạn code để thực hiện đuợc yêu cầu trên
Chi tiết theo file đính kèm
Sub ADO()
Dim lsSQL As String, Cnn As Object, Fso As Object, Fi As Object, lrs As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With Fso
For Each Fi In .GetFolder(ThisWorkbook.Path).Files
If Fi.Name <> ThisWorkbook.Name Then
MsgBox Fi.Path
With Cnn
If Val(Application.Version) < 12 Then
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fi.Path & ";Extended Properties=""Excel 8.0;HDR=No"";"
Else
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fi.Path & ";Extended Properties=""Excel 12.0;HDR=No"";"
End If
.Open
End With
lsSQL = "Select * From [Sheet1$A2:Z65536]"
lrs.Open lsSQL, Cnn
Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs
Cnn.Close
End If
Next
End With
Set lrs = Nothing
Set Cnn = Nothing
Set Fso = Nothing
End Sub
Để lấy dữ liệu file không mở bạn dùng ADO nhé
Mã:Sub ADO() Dim lsSQL As String, Cnn As Object, Fso As Object, Fi As Object, lrs As Object Set Fso = CreateObject("Scripting.FileSystemObject") Set Cnn = CreateObject("ADODB.Connection") Set lrs = CreateObject("ADODB.Recordset") With Fso For Each Fi In .GetFolder(ThisWorkbook.Path).Files If Fi.Name <> ThisWorkbook.Name Then MsgBox Fi.Path With Cnn If Val(Application.Version) < 12 Then .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fi.Path & ";Extended Properties=""Excel 8.0;HDR=No"";" Else .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fi.Path & ";Extended Properties=""Excel 12.0;HDR=No"";" End If .Open End With lsSQL = "Select * From [Sheet1$A2:Z65536]" lrs.Open lsSQL, Cnn Range("A65536").End(3).Offset(1, 0).CopyFromRecordset lrs Cnn.Close End If Next End With Set lrs = Nothing Set Cnn = Nothing Set Fso = Nothing End Sub
Cảm ơn bạn nhé, nhưng sao mình chạy marco trong workbook so sánh mà ko thấy dữ liệu update vào nhỉ
Nguyên nhân tại bạn sử dụng Table đến dòng 6273 nên excel hiểu là dòng 6272 là dòng cuối cùng có dữ liệu.Mình chạy marco đã ra dữ liệu nhưng sao tận dòng 6273 mới xuất hiện dữ liệu. Dữ liệu nếu xuất hiện từ dòng A2 trong workbook sosanh thì tốt quá.
Range("A[COLOR=#ff0000][B]65536[/B][/COLOR]").End(3).Offset(1, 0).CopyFromRecordset lrs
Nguyên nhân tại bạn sử dụng Table đến dòng 6273 nên excel hiểu là dòng 6272 là dòng cuối cùng có dữ liệu.
Để khắc phục bạn làm như sau: bạn thay phần đỏ thành 6273 (đây là vùng cuối của table của bạn), nếu sử dụng table bạn mở rộng vùng này ra để tránh bị sót. Còn không sử dụng Table thì bạn thoải mái dùng
Mã:Range("A[COLOR=#ff0000][B]65536[/B][/COLOR]").End(3).Offset(1, 0).CopyFromRecordset lrs
Chào bạn,Mình có vấn đè phát sinh là book1 và book 2 thực chất của mình nó khá nặng và yêu cầu phải mở khi chưa có code là ở dạng bảng Table.
File mình gửi lên bạn đã giải quyết rất ok roài, nhưng khi làm vào file thật của mình nó báo code không hỗ trợ dạng bảng. Bạn xem có cách nào khắc phục đuợc không nhé. Mình gửi lỗi theo file đính kèm nhé.
Cảm ơn bạn nhiều!
Chào bạn,
Bạn có thể xóa dữ liệu chỉ để lại 1 chút cho test với file thật của bạn lên đây để mọi người xem lỗi do cái gì, chứ nhìn thông báo lỗi thì quả là khó cho việc dự đoán lỗi.
Mình cũng đã nghĩ ra cách xử lý y hệt như bạn nói rồi. Talbe/list/Convert to range.Lỗi ở đây là do bạn lấy dữ liệu bằng cách Import từ 1 file XML nên khi mở Excel sẽ hiện thông báo.
Để khắc phục bạn làm như sau:
- Chọn 1 ô bất kỳ trong bảng sau đó phải chuột chọn Table => Convert to range
Khi chưa dùng ADO bạn có thể dùng theo dạng data import của excel nhưng khi sử dụng Code bạn không cần thiết phải sử dụng chức năng đó nữa.