Nhờ trợ giúp code VBA gộp file excel từ nhiều file excel khác (1 người xem)

[kaka01]

Gửi các anh/chị GPE!
Em đang vướng mắc phần về gộp file excel từ nhiều file khác
xin được các anh/chị trợ giúp!
Tình huống dữ liệu của em có 3 file
1. Tên file 1: Thang 5
Dữ liệu muốn tổng hợp ở Sheet ("Dulieu")
2. Tên file 2: Thang 6
Dữ liệu muốn tổng hợp ở Sheet ("Dulieu")
3. Tên file 3: Tonghopdulieu
Tổng hợp vào Sheet(THfile)
Trong file số 3 này có code tổng hợp từ sheet sang sheet
code trong module (Gopsheet) phần code này trước được anh HieuCD trợ giúp
khi đó chỉ là gộp từ Sheet sang Sheet vấn đề này em đã làm được
Giờ em muốn gộp từ các file thì em chưa ứng dụng được
(Yêu cầu chi tiết em ghi tại Sheet Data và Sheet THfile của file số 3)
Vậy nhờ các anh chị trợ giúp!

 

[HieuCD]

Gửi các anh/chị GPE!
Em đang vướng mắc phần về gộp file excel từ nhiều file khác
xin được các anh/chị trợ giúp!
Tình huống dữ liệu của em có 3 file
1. Tên file 1: Thang 5
Dữ liệu muốn tổng hợp ở Sheet ("Dulieu")
2. Tên file 2: Thang 6
Dữ liệu muốn tổng hợp ở Sheet ("Dulieu")
3. Tên file 3: Tonghopdulieu
Tổng hợp vào Sheet(THfile)
Trong file số 3 này có code tổng hợp từ sheet sang sheet
code trong module (Gopsheet) phần code này trước được anh HieuCD trợ giúp
khi đó chỉ là gộp từ Sheet sang Sheet vấn đề này em đã làm được
Giờ em muốn gộp từ các file thì em chưa ứng dụng được
(Yêu cầu chi tiết em ghi tại Sheet Data và Sheet THfile của file số 3)
Vậy nhờ các anh chị trợ giúp!

Các file cùng 1 thư mục

Sub TongHopFile()
  Dim wb As Workbook, strPath As String, FilesDulieu As Variant
  Dim sArr(), Res()
  Dim n As Long, i As Long, k As Long, j As Byte, eRow As Long
  Dim tmp, ngay, may As String
  Const sheetName = "Dulieu"
 
  FilesDulieu = Array("Thang 5", "Thang 6")
  strPath = ThisWorkbook.Path
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
 
  With Sheets("THfile") 'Xoa ket qua cu
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then .Range("A4:S" & eRow).Clear
  End With
 
  For n = LBound(FilesDulieu) To UBound(FilesDulieu)
    On Error Resume Next 'Bay loi khong co file va sheet dulieu
    Set wb = Workbooks.Open(strPath & "\" & FilesDulieu(n) & ".xlsx")
    tmp = wb.Sheets(sheetName).Name
    If Err.Number > 0 Then
      MsgBox ("Khong co File: " & FilesDulieu(n) & "hoac khong co sheet: " & sheetName)
      On Error GoTo 0
      GoTo Tiep
    End If
    On Error GoTo 0
    
    With wb.Sheets(sheetName)
      eRow = .Range("C" & Rows.Count).End(xlUp).Row
      If eRow < 5 Then MsgBox ("Khong co du lieu"): wb.Close False: GoTo Tiep
      sArr = .Range("A3:P" & eRow).Value
      eRow = UBound(sArr)
    End With
    wb.Close False

    ReDim Res(1 To eRow, 1 To UBound(sArr, 2) + 3)
    k = -1
    For i = 1 To eRow
      tmp = sArr(i, 1)
      If Len(tmp) = 10 And Mid(tmp, 3, 1) = "/" Then
        If Day(DateValue("2/9/2018")) = 2 Then
          ngay = CDate(tmp)
        Else
          ngay = DateSerial(CInt(Mid(tmp, 7, 4)), CInt(Mid(tmp, 4, 2)), CInt(Mid(tmp, 1, 2)))
        End If
        k = k + 1
      Else
        If TypeName(sArr(i, 2)) = "Double" Then
          k = k + 1
          Res(k, 1) = ngay: Res(k, 4) = may
          For j = 2 To UBound(sArr, 2)
            Res(k, j + 3) = sArr(i, j)
          Next j
        Else
          may = tmp
        End If
      End If
    Next i
    
    With Sheets("THfile")
      If k Then
        eRow = .Range("A" & Rows.Count).End(xlUp).Row
        If eRow = 3 Then eRow = 2
        .Range("A" & eRow + 2).Resize(k, 19) = Res
        .Range("A" & eRow + 2).Resize(k).NumberFormat = "mm/dd/yyyy"
        .Range("A" & eRow + 2).Resize(k, 19).Borders.LineStyle = 1
      End If
    End With
Tiep:
  Next n
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

 

[kaka01]

Các file cùng 1 thư mục

Sub TongHopFile()
  Dim wb As Workbook, strPath As String, FilesDulieu As Variant
  Dim sArr(), Res()
  Dim n As Long, i As Long, k As Long, j As Byte, eRow As Long
  Dim tmp, ngay, may As String
  Const sheetName = "Dulieu"

  FilesDulieu = Array("Thang 5", "Thang 6")
  strPath = ThisWorkbook.Path
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

  With Sheets("THfile") 'Xoa ket qua cu
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 3 Then .Range("A4:S" & eRow).Clear
  End With

  For n = LBound(FilesDulieu) To UBound(FilesDulieu)
    On Error Resume Next 'Bay loi khong co file va sheet dulieu
    Set wb = Workbooks.Open(strPath & "\" & FilesDulieu(n) & ".xlsx")
    tmp = wb.Sheets(sheetName).Name
    If Err.Number > 0 Then
      MsgBox ("Khong co File: " & FilesDulieu(n) & "hoac khong co sheet: " & sheetName)
      On Error GoTo 0
      GoTo Tiep
    End If
    On Error GoTo 0
   
    With wb.Sheets(sheetName)
      eRow = .Range("C" & Rows.Count).End(xlUp).Row
      If eRow < 5 Then MsgBox ("Khong co du lieu"): wb.Close False: GoTo Tiep
      sArr = .Range("A3:P" & eRow).Value
      eRow = UBound(sArr)
    End With
    wb.Close False

    ReDim Res(1 To eRow, 1 To UBound(sArr, 2) + 3)
    k = -1
    For i = 1 To eRow
      tmp = sArr(i, 1)
      If Len(tmp) = 10 And Mid(tmp, 3, 1) = "/" Then
        If Day(DateValue("2/9/2018")) = 2 Then
          ngay = CDate(tmp)
        Else
          ngay = DateSerial(CInt(Mid(tmp, 7, 4)), CInt(Mid(tmp, 4, 2)), CInt(Mid(tmp, 1, 2)))
        End If
        k = k + 1
      Else
        If TypeName(sArr(i, 2)) = "Double" Then
          k = k + 1
          Res(k, 1) = ngay: Res(k, 4) = may
          For j = 2 To UBound(sArr, 2)
            Res(k, j + 3) = sArr(i, j)
          Next j
        Else
          may = tmp
        End If
      End If
    Next i
   
    With Sheets("THfile")
      If k Then
        eRow = .Range("A" & Rows.Count).End(xlUp).Row
        If eRow = 3 Then eRow = 2
        .Range("A" & eRow + 2).Resize(k, 19) = Res
        .Range("A" & eRow + 2).Resize(k).NumberFormat = "mm/dd/yyyy"
        .Range("A" & eRow + 2).Resize(k, 19).Borders.LineStyle = 1
      End If
    End With
Tiep:
  Next n
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Cảm ơn anh HieuCD nhiều!
Em hiểu thêm được một cách gộp file VBA không cần mở file
kết quả đã đáp ứng yêu cầu tình huống của em rùi ạ
em tìm hiểu thêm có gì chưa hiểu xin nhờ anh hỗ trợ tiếp
Nhân tiện anh có thể giúp em tình huống tương tự như bài này với ạ
*Cụ thể em có 3 file(Dulieu_1,Dulieu_2 và Dulieu_3)
Mỗi file này phần dữ liệu có dòng trống tại sheet "RH"
sẽ gộp vào sheet "TH" của file Gopfile,
1. Em tham khảo trên diễn đàn cách gộp file: copy Range về sheet "TH" rồi xóa dòng trống(em đã làm được)
2. Giờ em muốn dùng một mảng để lọc dòng trống sau đó mới gắn xuống sheet "TH" của file Gopfile
nhưng chưa được, anh có thể xem code trong module(Gopfile)của file Gopfile sửa giúp em với
vì ban đầu em định dùng cách này cho bài toán trên nhưng không được
Trân trọng cảm ơn anh!

 

[HieuCD]

Cảm ơn anh HieuCD nhiều!
Em hiểu thêm được một cách gộp file VBA không cần mở file
kết quả đã đáp ứng yêu cầu tình huống của em rùi ạ
em tìm hiểu thêm có gì chưa hiểu xin nhờ anh hỗ trợ tiếp
Nhân tiện anh có thể giúp em tình huống tương tự như bài này với ạ
*Cụ thể em có 3 file(Dulieu_1,Dulieu_2 và Dulieu_3)
Mỗi file này phần dữ liệu có dòng trống tại sheet "RH"
sẽ gộp vào sheet "TH" của file Gopfile,
1. Em tham khảo trên diễn đàn cách gộp file: copy Range về sheet "TH" rồi xóa dòng trống(em đã làm được)
2. Giờ em muốn dùng một mảng để lọc dòng trống sau đó mới gắn xuống sheet "TH" của file Gopfile
nhưng chưa được, anh có thể xem code trong module(Gopfile)của file Gopfile sửa giúp em với
vì ban đầu em định dùng cách này cho bài toán trên nhưng không được
Trân trọng cảm ơn anh!

Qua 1 vòng For, K sẽ có giá trị >0, cần có lệnh K=0 ở đầu hoặc cuối For

 

[kaka01]

Qua 1 vòng For, K sẽ có giá trị >0, cần có lệnh K=0 ở đầu hoặc cuối For

Cảm ơn anh nhiều!
em đã làm được theo hướng dẫn của anh
vậy mà em nghĩ mãi không ra!
Trân trọng cảm ơn anh!