Xin code tìm file (con) trong thư mục và chèn các sheet của file đó vào cạnh file gốc (1 người xem)

[kydang1989]

Mình có 2 file excel
File gốc: Baocao.xlsx gồm sheet “baocao”
File con: Dulieu.xlsx gồm các sheet: “khachhang” + sheet “hopdong” + sheet”doanhthu”…

Mình muốn khi đang mở file gốc (không mở file con), đứng ở file gốc, chạy macro thì nó hiện lên 1 cái bảng bắt mình chỉ nó đến đường dẫn của file con: Dulieu.xlsx. Sau đó nó sẽ tự động copy toàn bộ các sheet của file Dulieu.xlsx bỏ kế bên sheet “baocao” trong file Baocao.xlsx
Kết quả sẽ được: Baocao.xlsx gồm các sheet “baocao” + sheet “khachhang” + sheet “hopdong” + sheet”doanhthu”…

(tên file con: không cố định, ví dụ tháng 8 thì nó nằm trong thư mục: Thang8/Dulieu_T8.xlsx, tháng 9 nằm trong thư mục: Thang9/Dulieu_T9.xlsx, chỉ có thể chỉ nó đến thẳng đường dẫn file đó và nhấp vào)

 

[Quang_Hải]

Mình có 2 file excel
File gốc: Baocao.xlsx gồm sheet “baocao”
File con: Dulieu.xlsx gồm các sheet: “khachhang” + sheet “hopdong” + sheet”doanhthu”…

Mình muốn khi đang mở file gốc (không mở file con), đứng ở file gốc, chạy macro thì nó hiện lên 1 cái bảng bắt mình chỉ nó đến đường dẫn của file con: Dulieu.xlsx. Sau đó nó sẽ tự động copy toàn bộ các sheet của file Dulieu.xlsx bỏ kế bên sheet “baocao” trong file Baocao.xlsx
Kết quả sẽ được: Baocao.xlsx gồm các sheet “baocao” + sheet “khachhang” + sheet “hopdong” + sheet”doanhthu”…

(tên file con: không cố định, ví dụ tháng 8 thì nó nằm trong thư mục: Thang8/Dulieu_T8.xlsx, tháng 9 nằm trong thư mục: Thang9/Dulieu_T9.xlsx, chỉ có thể chỉ nó đến thẳng đường dẫn file đó và nhấp vào)

Sub Mo_Nhieu_File_De_Copy_Sheet()
Dim FilesToOpen As Variant, y As Long
Dim sh As Worksheet, CurrentWB As Workbook
Set CurrentWB = ThisWorkbook
FilesToOpen = Application.GetOpenFilename("Excel Files,*.xls?", , , , True)
If Not IsArray(FilesToOpen) Then
    MsgBox "No Files Were Selected"
    Exit Sub
Else
   For y = 1 To UBound(FilesToOpen)
      Workbooks.Open FilesToOpen(y)
      With ActiveWorkbook
         For Each sh In .Worksheets
            If sh.UsedRange.Rows.Count > 0 Then
               sh.Copy CurrentWB.Sheets(CurrentWB.Sheets.Count)
            End If
         Next
         .Close False
      End With
   Next
End If
End Sub