Copy dữ liệu từ nhiều file vào 1 file trong cùng thư mục

Chia sẻ bởi:hands

★★★★★

‹ Tham chiếu qua nhiều sheet liệt kê những mặt hàng có trong... ›

Quảng cáo

Chào các bạn

Ngày nào mình cũng copy dữ liệu từ nhiều file vào 1 file "Tong hop" để xử lý, file này có 2 sheet: sheet Data và sheet Lam viec
Sheet Data được copy dữ liệu lần lượt từ 3 file "Data 1", "Data 2", "Data 3". Dữ liệu trong 3 file này và sheet "Data" có số cột như nhau. Số dòng trong 3 file không cố định, thay đổi theo ngày
Sheet Lam viec và file "Lam viec" cũng có số cột như nhau, còn dòng trong file "Lam viec" cũng thay đổi theo ngày

Nhờ các bạn viết code giúp mình làm việc sau:
– Copy dữ liệu lần lượt từ file "Data 1", "Data 2", "Data 3" vào sheet Data của file "Tong hop", vị trí bắt đầu copy từ 3 file là A2.
– Chuyển định dạng dữ liệu cột 4 trong sheet Data từ text sang number (3 file kia xuất từ phần mềm chuyên dụng ra, dữ liệu cột 4 là số nhưng bị định dạng thành text)
– Copy dữ liệu từ file "Lam viec" vào sheet Lam viec, vị trí bắt đầu copy từ file "Lam viec" là A2

Cám ơn các bạn

Copy code này về cho vào 1 module. Code này dùng chung cho 2 code bên dưới

Function GetExcelConnection(ByVal Path As String, Optional ByVal Header As Boolean = True)
Dim StrConn As String, ObjConn As Object, Pro As String, Ext As String
Set ObjConn = CreateObject("ADODB.Connection")
If Application.Version < 12 Then
Pro = "Provider=Microsoft.JET.OLEDB.4.0;"
Ext = ";Extended Properties=""Excel 8.0;"
Else
Pro = "Provider=Microsoft.ACE.OLEDB.12.0;"
Ext = ";Extended Properties=""Excel 12.0;"
End If
StrConn = Pro & "Data Source=" & Path & Ext & _
"HDR=" & IIf(Header, "Yes", "No") & ";IMEX=1"";"
ObjConn.Open StrConn
Set GetExcelConnection = ObjConn
End Function

Copy code này về cho vào 1 module. Chạy code này để copy data 1, 2, 3
Nếu có nhiều file hơn thì thêm chỗ này
sheetList = Array("Data 1.xlsx", "Data 2.xlsx", "Data 3.xlsx")

Sub DataCopy()
Dim ObjConn As Object, RS As Object
Dim StrRequest As String, Path As String
Dim sheetList(), i As Long
sheetList = Array("Data 1.xlsx", "Data 2.xlsx", "Data 3.xlsx")
Path = ThisWorkbook.Path
Set RS = CreateObject("ADODB.Recordset")
For i = LBound(sheetList) To UBound(sheetList)
Set ObjConn = GetExcelConnection(Path & "" & sheetList(i), 1)
StrRequest = "SELECT * FROM [Sheet1$]"
RS.Open StrRequest, ObjConn, 3, 1
Sheets("Data")..End(3)(2).CopyFromRecordset RS
ObjConn.Close
Next
Set RS = Nothing
Set ObjConn = Nothing
End Sub

Code này copy file lam viec

Sub LamViec()
Dim ObjConn As Object, RS As Object
Dim StrRequest As String, Path As String
Path = ThisWorkbook.Path & "lam viec.xlsx"
Set RS = CreateObject("ADODB.Recordset")
Set ObjConn = GetExcelConnection(Path, 1)
StrRequest = "SELECT * FROM [Sheet1$]"
RS.Open StrRequest, ObjConn, 3, 1
Sheets("Lam viec")..End(3)(2).CopyFromRecordset RS
ObjConn.Close
Set RS = Nothing
Set ObjConn = Nothing
End Sub

Chưa thử kỹ code. Có gì tính sau
Lưu ý là tất cả file đều nằm chung 1 folder

www.giaiphapexcel.com/diendan/threads/copy-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-nhi%E1%BB%81u-file-v%C3%A0o-1-file-trong-c%C3%B9ng-th%C6%B0-m%E1%BB%A5c.96181/