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

[thienthanvuive]

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

 

[Quang_Hải]

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").[A65536].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").[A65536].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

 

[thienthanvuive]

Cám ơn quanghai1969

Code của bạn chạy copy từ các file ok, có vài vấn đề nhờ bạn giúp
- Trong sheet Data của file "Tong hop", dữ liệu ở cột 4 chưa chuyển được dữ liệu dạng text sang number ở cột 4, nhờ bạn cho mình code để chuyển dữ liệu từ text sang number
- Trong sheet Data của file "Tong hop", lúc đầu mình nhờ là copy bắt đầu từ vị trí A2, trong đoạn code của bạn thể hiện chỗ nào vậy để mình có thể tuỳ chỉnh

Cám ơn nhiều

 

[Kiều Mạnh]

Cám ơn quanghai1969

Code của bạn chạy copy từ các file ok, có vài vấn đề nhờ bạn giúp
- Trong sheet Data của file "Tong hop", dữ liệu ở cột 4 chưa chuyển được dữ liệu dạng text sang number ở cột 4, nhờ bạn cho mình code để chuyển dữ liệu từ text sang number
- Trong sheet Data của file "Tong hop", lúc đầu mình nhờ là copy bắt đầu từ vị trí A2, trong đoạn code của bạn thể hiện chỗ nào vậy để mình có thể tuỳ chỉnh

Cám ơn nhiều

Bạn sửa lại dòng này nhé

 Sheets("Data").[A65536].End(3)(2).CopyFromRecordset RS

Còn "text sang number" Bạn Tìm trên GPE có rất nhiều

 

[Quang_Hải]

Cám ơn quanghai1969

Code của bạn chạy copy từ các file ok, có vài vấn đề nhờ bạn giúp
- Trong sheet Data của file "Tong hop", dữ liệu ở cột 4 chưa chuyển được dữ liệu dạng text sang number ở cột 4, nhờ bạn cho mình code để chuyển dữ liệu từ text sang number
- Trong sheet Data của file "Tong hop", lúc đầu mình nhờ là copy bắt đầu từ vị trí A2, trong đoạn code của bạn thể hiện chỗ nào vậy để mình có thể tuỳ chỉnh

Cám ơn nhiều

1. Nếu dữ liệu trong cột 4 của bạn toàn bộ là number thì tự nhiên copy qua sẽ là number, nếu có Text xen kẽ thì copy qua sẽ là Text tất cả.
2. Xem hướng dẫn của bài 4
Tiện đây sửa lại code copydata 1 chút cho gọn hơn.
Nếu bạn có nhiều file cùng mang tên Data 1,2,3,4,5....n thì xài code này. Chỉ cần thay số 1 to 3 thành 1 to n

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

 

[trungpp]

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").[A65536].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").[A65536].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

Đang lục tìm món copy từ file con về file tổng hợp, thấy cái này gần như đúng ý, chỉ còn ý nhỏ là để sau khi copy xong thì tự động xoá dữ liệu cũ từ các file data thì mình phải làm thế nào nhỉ? Nhờ anh hỗ trợ giúp với.

Cám ơn anh nhiều

 

[trungpp]

Dùng VBA thì đơn giản như ăn kẹo, còn việc dùng ADO thì mình không chắc là có xóa được kiểu đó không (ADO mình tịt)? Nếu bạn muốn thì có thể lập topic khác để hỏi, kèm file lên luôn để tiện xem xét.

vậy nhờ bạn hỗ trợ mình dùng VBa với
Mình gửi file đính kèm. Ở topic khác mình cũng có đưa vấn đề này lên và hình như bạn đã hỗ trợ. Tuy nhiên lần trước cái hướng nó khác chút như sau đó khó khăn trong việc share file nên chuyể sang tách riêng từng file nhập liệu.

yêu cầu đặt ra:
- file nhập liệu có các tên tương ứng với từng khu vực như: AnGiang2016, BacLieu2016,..... và file tổng hợp có sheet master dùng để tổng hợp dữ liệu từ các file con
- dữ liệu sẽ được copy từ các file con thông qua các sheet có tên tương ứng như: sheets"AnGiang", sheets"BacLieu",... và mình cố định nó là sheet9 trong mỗi file
- sau khi copy xong thì tự xoá dữ liệu cũ trên các file con để phục vụ cho đợt nhập liệu tiếp theo
- Khi thực hiện copy/xoá thì không cần mở các file con lên nhưng vẫn thực hiện được

pass cho các chức năng trên form:
- "Nộp Biên Bản": 123456
- Admin/call center: admin

Nhờ bạn hỗ trợ giúp nha

Link down file:
https://drive.google.com/file/d/0B1mEX5gYaqm7SFYzTUhydk9jVnM/view?usp=sharing

cám ơn bạn nhiều

 

[trungpp]

1. Các file con của bạn có code gì trong đó như đám rừng, tôi không tài nào mở đươc...Cho nên khi test code tôi vô hiệu hóa tất cả các code trong sự kiện Open file con của bạn thì mới test được... => chắc chắn 1 điều rằng code của bạn còn lũng cũng...bạn nên xem lại trong đó nếu muốn chạy tiếp....

2. Code tôi viết dựa vào tên file của bạn để xác định lấy dữ liệu từ sheet nào trong file đó...

Ví dụ tên file cố định là lấy các ký tự đầu trừ 4 ký tự cuối (năm 2016). Ví dụ file là Baclieu2016 mặc nhiên sẽ theo điều kiện này mà đặt tên file và tên sheet sẽ loại bỏ 2016 -> Baclieu

Bạn tự test code và tự phát triển thêm.

P/s: khi chạy code nhớ để tất cả cùng 1 thư mục

Public Sub GPE()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim ChonO As Object, ChonF As Object, pFile, Path, ShName As String
Dim fil As Object, Wb As Workbook, Sh As Worksheet, WbMain As Workbook
Dim Arr, dArr(1 To 500000, 1 To 35), I As Long, J As Long, K As Long
pFile = ActiveWorkbook.Name: Path = ThisWorkbook.Path
Set WbMain = ActiveWorkbook
Set ChonO = CreateObject("Scripting.FilesyStemObject")
Set ChonF = ChonO.GetFolder(Path)
For Each fil In ChonF.Files
    If InStr(1, fil.Name, pFile) < 1 Then
        Set Wb = Workbooks.Open(fil.Path)
        ShName = Left(ChonO.GetBaseName(fil), Len(ChonO.GetBaseName(fil)) - 4)
        Set Sh = Wb.Sheets(ShName)
        Arr = Sh.Range("B3", Sh.Range("B65000").End(3)).Resize(, 34).Value
            For I = 1 To UBound(Arr)
                If Len(Arr(I, 1)) Then
                    K = K + 1
                        dArr(K, 1) = K
                    For J = 1 To UBound(Arr, 2)
                        dArr(K, J + 1) = Arr(I, J)
                    Next J
                End If
            Next I
        Sh.Range("B3", Sh.Range("B65000").End(3)).Resize(, 34).Value = Empty
        Workbooks(fil.Name).Close True
    End If
Next fil
With WbMain.Sheets("Master")
    .Range("A1000000").End(3)(2).Resize(K, 35).Value = dArr
End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Cám ơn bạn đã hỗ trợ. Bạn nhận xét chính xác vì mình mới mò đến với VBA và excel thôi. Trước đây mình đã từng đăng ký thành viên ở diễn đàn này nhưng chưa có nhu cầu nhiều và cũng ít đụng chạm nhiều đến excel nên chưa tìm hiểu, giờ có việc cần mới tập tành hà.
Nhưng mà nói thật, đã tham gia rất nhiều diện đàn rồi nhưng cái diễn đàn này quả thật mọi người hỗ trợ nhau nhiệt tình quá, giúp nhau mà chu đáo hơn cả cái đó là của mình nữa hehe

Để mình mò và chế biến cái code của bạn tiếp xem sao, có khó khăn gì hỗ trợ mình tiếp nha. Thank you

 

[trungpp]

Thông cảm, bạn nói tiếng nào ra tiếng đó...Tôi không biết từ tiếng Anh nào hết...nên đọc cũng không hiểu đâu! Đừng mất cong ghi tiếng anh/tiếng em mất công tôi dịch sai khổ tôi lắm!

Vả lại GPE có cả cái nút "Cảm ơn" cơ mà!

rồi rồi ghi nhận ý kiến của Bạn. Mà cái nút cảm ơn trên bài của bạn sau không thấy nhỉ?

Đoạn code mình đang ráp vào cái của mình, nói chung chạy ổn và đúng ý của mình rồi. Chỉ có phát sinh thêm tý là nếu muốn lúc copy nó bỏ qua file nào đó không cần truy xuất vào thì mình chỉnh lại code thế nào hả bạn? Ví dụ như trong folder này mình có 01 file là "Database" và muốn bỏ qua file này thì phải làm sao? Mình thử lồng If...vào nhưng chắc chưa đúng cách nên chưa có tác dụng. Khi quét tới file này thì nó lại open lên. Nhờ Bạn hỗ trợ với.

Cám ơn bạn nhiều