Gửi bởi
lenongree
Dạ, để em gửi 3 file thử!!!
1. Bạn xóa 3 sheet đã ví dụ trong file hoàn thành (vì chạy code trùng tên cũ thì ko được). Copy code sau cho vào Module của file hoàn thành. Lưu file này đuôi .xlsm hoặc .xlsb thì mới chứa được code VBA
2. Cho 4 file trên vào 1 Folder. Chạy code -> của sổ mở ra -> Chọn nguyên Folder và OK. Đợi xíu chạy xong
P/s: Code trên chỉ lấy sheet có tên là VTU trong các file con. Bạn muốn copy nhiều file hơn nữa thì cứ tống các file đó vào Folder trên... (theo trên thì bạn nói là 12 file gì đó.)
Code trên viết theo tên sheet là VTU, thực tế của bạn khác thì bạn tự chỉnh sửa lại cho phù hợp mà chạy.
Chỉ cần code này trên file tổng hợp, các file con bạn đưa vào folder và chạy thì nó tự tổng hơp => Không cần phải mở file con.
Mã:
Option Explicit
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
pFile = ActiveWorkbook.Name
Set WbMain = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Chon Folder"
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Path = .SelectedItems(1) & "\"
End With
Set ChonO = CreateObject("Scripting.FilesyStemObject")
Set ChonF = ChonO.GetFolder(Path)
For Each fil In ChonF.Files
If InStr(1, fil.Name, pFile) <= 0 Then
Set Wb = Workbooks.Open(fil.Path)
ShName = ChonO.GetBaseName(fil)
For Each Sh In Wb.Worksheets
If Sh.Name = "VTU" Then
Sh.Copy After:=WbMain.Sheets(WbMain.Sheets.Count)
WbMain.Sheets(WbMain.Sheets.Count).Name = ShName
End If
Next Sh
Workbooks(fil.Name).Close
End If
Next fil
Application.CutCopyMode = False
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Trả lời kèm Trích dẫn
