Tổng hợp dữ liệu từ nhiều file excel theo từng ngày vào file excel đóng

[Bình22222]

Chào mọi người.

Nhờ mọi người giúp mình vấn đề gộp các file excel riêng lẻ vào 1 sheet trong file excel.
Mình đã lên các diễn đàn và youtube xem hướng dẫn dùng VBA giải quết cho vấn đề này, nhưng mình không làm được cho trường hợp của mình, rất mong được mọi người giúp đỡ.

Trong tháng mình có khoảng hơn 100 file excel ghi nhận báo cáo kiểm tra chất lượng sản phẩm, mỗi file có 4 sheet.
Mình cần gộp sheet tên "ket qua KT " ở các file excel khác nhau vào chung 1 sheet, dòng bắt đầu lấy dữ liệu là dòng 12.
Lưu ý trong file excel của mình:
- dòng 4 đến dòng 8 bị ẩn và có chứa công thức liên kết với các sheet trong file excel.
- vùng G12:L12 sẽ bị thay đổi dữ liệu theo từng file excel.
- số dòng chứa dữ liệu khác nhau với mỗi file excel khác nhau (dao động từ 30 tới 300 dòng).
- các file excel sẽ được cập nhật dữ liệu theo ngày.

Cám ơn mọi người và diễn đàn.

 

[Bình22222]

Trong thư mục có nhiều file hệ thống tự lưu, nên xóa các file nầy
Chỉnh lại Function GetFilesInFolder

Private Function GetFilesInFolder(ByVal pathFolder As String, ByVal extensionFile As String) As Variant
    Dim FSo As Object, objFolder As Object, objFile As Object, res As Variant, i As Long
    Dim wb_name As String, path
    wb_name = ThisWorkbook.FullName
  
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSo.GetFolder(pathFolder)
    extensionFile = VBA.UCase$(extensionFile)
    If objFolder.Files.Count < 1 Then Exit Function
  
    For Each objFile In objFolder.Files
        If VBA.UCase$(FSo.GetExtensionName(objFile)) Like extensionFile Then
            path = objFile.path
            If Left(objFile.Name, 1) <> "~" Then
                If path <> wb_name Then
                    i = i + 1
                    ReDim Preserve res(1 To i)
                    res(i) = path
                End If
            End If
         End If
    Next objFile
    GetFilesInFolder = res
End Function

Mặc dù e đã "show hidden files" để xóa hết các file ẩn như anh hướng dẫn, nhưng vẫn nhận được thông báo như hình.

 

[HieuCD]

Mặc dù e đã "show hidden files" để xóa hết các file ẩn như anh hướng dẫn, nhưng vẫn nhận được thông báo như hình.
View attachment 226238

Chỉnh lại

Private Function GetFilesInFolder(ByVal pathFolder As String, ByVal extensionFile As String) As Variant
    Dim FSo As Object, objFolder As Object, objFile As Object, res(), i As Long
    Dim wb_name As String, path
    wb_name = ThisWorkbook.FullName
    
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSo.GetFolder(pathFolder)
    extensionFile = VBA.UCase$(extensionFile)
    If objFolder.Files.Count < 1 Then Exit Function
    
    For Each objFile In objFolder.Files
        If VBA.UCase$(FSo.GetExtensionName(objFile)) Like extensionFile Then
            path = objFile.path
            If Left(objFile.Name, 1) <> "~" Then
                If path <> wb_name Then
                    i = i + 1
                    ReDim Preserve res(1 To i)
                    res(i) = path
                End If
            End If
         End If
    Next objFile
    GetFilesInFolder = res
End Function

 

[Bình22222]

Chỉnh lại

Private Function GetFilesInFolder(ByVal pathFolder As String, ByVal extensionFile As String) As Variant
    Dim FSo As Object, objFolder As Object, objFile As Object, res(), i As Long
    Dim wb_name As String, path
    wb_name = ThisWorkbook.FullName
   
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSo.GetFolder(pathFolder)
    extensionFile = VBA.UCase$(extensionFile)
    If objFolder.Files.Count < 1 Then Exit Function
   
    For Each objFile In objFolder.Files
        If VBA.UCase$(FSo.GetExtensionName(objFile)) Like extensionFile Then
            path = objFile.path
            If Left(objFile.Name, 1) <> "~" Then
                If path <> wb_name Then
                    i = i + 1
                    ReDim Preserve res(1 To i)
                    res(i) = path
                End If
            End If
         End If
    Next objFile
    GetFilesInFolder = res
End Function

Rất cám ơn anh "HieuCD" Code đã chạy được.

Em gửi file hoàn chỉnh lên đây để mọi người cần thì tham khảo nha.
Cám ơn anh "HieuCD" và diễn đàn.

 

[leonkkt]

Rất cám ơn anh "HieuCD" Code đã chạy được.

Em gửi file hoàn chỉnh lên đây để mọi người cần thì tham khảo nha.
Cám ơn anh "HieuCD" và diễn đàn.

Mình có cùng thắc mắc nên cám ơn bạn rất nhiều vì đã tổng hợp lại thành file hoàn chỉnh. lúc mình tải về tham khảo cho trường hợp của mình thì file RAR bị báo lỗi. Bạn vui lòng check lại giúp được không Binh22222.

 

[quick87]

Mình có cùng thắc mắc nên cám ơn bạn rất nhiều vì đã tổng hợp lại thành file hoàn chỉnh. lúc mình tải về tham khảo cho trường hợp của mình thì file RAR bị báo lỗi. Bạn vui lòng check lại giúp được không Binh22222.

Anh tải file đính kèm nhé !

 

[Bình22222]

Mình có cùng thắc mắc nên cám ơn bạn rất nhiều vì đã tổng hợp lại thành file hoàn chỉnh. lúc mình tải về tham khảo cho trường hợp của mình thì file RAR bị báo lỗi. Bạn vui lòng check lại giúp được không Binh22222.

Gửi bạn leonkkt file cập nhật lại nhe.
Mình xin gửi từng file excel đơn lên diễn đàn để mọi người dùng phòng khi file nén bị trục trặc, mong admin đừng xóa nhe.
Cảm ơn diễn đàn.