Sửa lỗi code nối dữ liệu từ nhiều file vào 1 file (1 người xem)

[hungdiep85]

Chào các Thầy

Sửa lỗi giúp em file này với, khi có file đang mở mà chạy code ở file TongHop thì báo lỗi.

Em cảm ơn các Thầy.

 

[be_09]

Chào các Thầy

Sửa lỗi giúp em file này với, khi có file đang mở mà chạy code ở file TongHop thì báo lỗi.

Em cảm ơn các Thầy.

Em sử dụng File này thử xem.

Cách gộp File thì em xem sheet hướng dẫn trong File Gộp các File vào 1 File, trong File anh đã chạy Macro gộp File rồi, bây giờ em nhấn nút Gộp các sheet trong Sheet Gop_File thì sẽ được dữ liệu, xong sang Sheet THCacToBanDo nhấn vào 1 trong 2 nút để chạy Pivottable, Code anh đã mở.

Tùy theo loại File Excel mà ở sheet Huong dan, tại B4 em chọn loại cho phù hợp với File cần gộp, sau đó mới nhấn nút Gộp các File Excel, tiếp theo mới nhấn nút Gộp các sheet.

Code trong Module có tên TongHop dùng để chạy Pivottable, nếu em muốn tổng hợp thì sửa tên tiêu đề cột trong Code, em có thể sử dụng cho bất kỳ vị trí của tiêu đề (Lưu ý: tên tiêu đề không sử dụng dấu tiếng Việt, Code sẽ bị lỗi), tải File theo Link:

https://app.box.com/s/5s4gswnwwetojab7gbqy

 

[Quang_Hải]

Chào các Thầy

Sửa lỗi giúp em file này với, khi có file đang mở mà chạy code ở file TongHop thì báo lỗi.

Em cảm ơn các Thầy.

Nếu bạn đã am hiểu về code thì dùng ADO cho nó oai, còn nếu chỉ mới tập tành như mình thì dùng code này cho dễ hiểu

Sub Main()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FileName, SheetName, Path As String, Chk As Boolean
Dim I As Byte, J As Byte, CurWB As Worksheet, WB As Workbook
Path = ThisWorkbook.Path
FileName = Array("File1", "File2", "File3", "File4")
SheetName = Array("Chitiet1", "Chitiet2", "Chitiet3")
Set CurWB = ThisWorkbook.Sheets("TongHop")
CurWB.[A2:J65536].ClearContents
For I = 0 To UBound(FileName)
   For Each WB In Workbooks
      If WB.Name = FileName(I) Then Chk = True
   Next
   If Chk = False Then
      Workbooks.Open Path & "\" & FileName(I) & "-Chitiet.xlsm"
   End If
   With Workbooks(FileName(I) & "-Chitiet.xlsm")
      For J = 0 To UBound(SheetName)
         With .Sheets(FileName(I) & "-" & SheetName(J))
            .Range(.[A2], .[J65536].End(3)).Copy
            CurWB.[A65536].End(3).Offset(1).PasteSpecial 1
         End With
      Next
      .Close
   End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done"
End Sub

 

[hungdiep85]

Nếu bạn đã am hiểu về code thì dùng ADO cho nó oai, còn nếu chỉ mới tập tành như mình thì dùng code này cho dễ hiểu

Sub Main()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FileName, SheetName, Path As String, Chk As Boolean
Dim I As Byte, J As Byte, CurWB As Worksheet, WB As Workbook
Path = ThisWorkbook.Path
FileName = Array("File1", "File2", "File3", "File4")
SheetName = Array("Chitiet1", "Chitiet2", "Chitiet3")
Set CurWB = ThisWorkbook.Sheets("TongHop")
CurWB.[A2:J65536].ClearContents
For I = 0 To UBound(FileName)
   For Each WB In Workbooks
      If WB.Name = FileName(I) Then Chk = True
   Next
   If Chk = False Then
      Workbooks.Open Path & "\" & FileName(I) & "-Chitiet.xlsm"
   End If
   With Workbooks(FileName(I) & "-Chitiet.xlsm")
      For J = 0 To UBound(SheetName)
         With .Sheets(FileName(I) & "-" & SheetName(J))
            .Range(.[A2], .[J65536].End(3)).Copy
            CurWB.[A65536].End(3).Offset(1).PasteSpecial 1
         End With
      Next
      .Close
   End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done"
End Sub

Dạ. Em không biết gì về code đầu Thầy àh, code này là của Thầy(ndu96081631), giờ em chỉ còn 1 bước là áp dụng vào công việc được rùi. Mong Thầy giúp àh.

Em cảm ơn Thầy nhiều