Copy tất cả các sheet của các file excel trong thư mục vào 1 file.

[tranviethung]

Mình xin lỗi voda và các bạn, mình đã gửi lại File trong đó có macro.

Các bạn xem giúp sao khi chạy còn lỗi gì mà không thể copy File vào File Hung1.xls,mình có kiểm tra các file copy vào nếu cột F không có Dl(dòng 5-31) thì sẽ không copy. Các sheet copy vao đặt sau sheet 1 va tên theo số thứ tự tăng dần. Mình gửi File Hung1.xls có chứa macro Auto để copy File và 1 số file DL để chạy thử các bạn xem giúp nhé. Cần sớm các bạn à, a và mình muốn gọi sub Tachso bên dưới vào trong Sub Auto các bạn à ,thanks alot !

 

[ThuNghi]

Các bạn xem giúp sao khi chạy còn lỗi gì mà không thể copy File vào File Hung1.xls,mình có kiểm tra các file copy vào nếu cột F không có Dl(dòng 5-31) thì sẽ không copy. Các sheet copy vao đặt sau sheet 1 va tên theo số thứ tự tăng dần. Mình gửi File Hung1.xls có chứa macro Auto để copy File và 1 số file DL để chạy thử các bạn xem giúp nhé. Cần sớm các bạn à, a và mình muốn gọi sub Tachso bên dưới vào trong Sub Auto các bạn à ,thanks alot !

Bạn xem qua bài của RollOver79 có nói về vấn đề này. Rất hay.
http://www.giaiphapexcel.com/forum/showthread.php?t=13684&page=2

 

[tranviethung]

Vấn đề chưa được giả quyết!

Thế nhưng minh muốn sử dụng lựa chọn Multiselection, chọn nhiều file, mà theo mình thấy sử dụng cách như bạn giứo thiệu thì nếu file có nhiều sheet(>200) thì chọn đánh dấu đến bao giờ, sao không có thêm lựa chọn all sheet và nếu thấy sheet nào không cần copy thi chỉ việc bỏ chọn là xong, với lại lúc chọn file xong mình thấy nó chọn rất chậm, có thể cải tiến tốc độ được không ThuNghi, thanks

 

[rollover79]

Thế nhưng minh muốn sử dụng lựa chọn Multiselection, chọn nhiều file, mà theo mình thấy sử dụng cách như bạn giứo thiệu thì nếu file có nhiều sheet(>200) thì chọn đánh dấu đến bao giờ, sao không có thêm lựa chọn all sheet và nếu thấy sheet nào không cần copy thi chỉ việc bỏ chọn là xong, với lại lúc chọn file xong mình thấy nó chọn rất chậm, có thể cải tiến tốc độ được không ThuNghi, thanks

- Để thêm 1 cái Select All cho 1 cái Listbox thì đâu có khó, bạn có thể tự thêm được mà, còn việc sau khi chọn File xong nó chậm là vì nó phải mở tất cả các file và duyệt trên tất cả các Sheets trên các file đó nên sẽ chậm là đương nhiên rồi.

 

[ThuNghi]

mình có kiểm tra các file copy vào nếu cột F không có Dl(dòng 5-31) thì sẽ không copy

Tôi thấy cột F sh nào cũng có DL, ý bạn nói là cột F của Sh nào.
Có phải bạn muốn copy toàn bộ các Sh của các file nằm trong folder Data vào hung1.xls, và đặt tên theo TT: 01, 02,..., 0n.
Tôi gợi ý như như sau:
1/ Tại hung1..xls chạy code
2/ Mở từng file và copy hết tòan bộ Sh sang
3/ Đóng file vừa mở
4/ Kiểm tra cột F, nếu No OK thì xóa Sh
5/ Duyệt qua các Sh và đặ tên.
6/ Mở file khác và ...

'MyPath = "D:\Hung_Macro DA Gia dien" 'Khai bao duong dan co dinh chua cac file can copy, neu sua thi sua cho nay

Cái này nên sửa lại là

MyPath = ThisWorkbook.Path

Lúc đầu vào code thì nên viêt dòng này,
Set BaseBook = Workbooks("Hung1.xls")
và nên thay là
Set BaseBook = ThisWorkbook, chắc chắn là ta đang mở hung1.xls.
Vài lời góp ý.

 

[voda]

Trong 2 file mẫu bạn gởi, không có sheet nào có dữ liệu từ dòng 5 đến 31 ở cột F. Vậy theo yêu cầu là không copy sheet nào cả! Bạn kiểm tra lại thử. Nếu yêu cầu không rõ, các bạn trên diễn đàn khó giúp bạn.

 

[tranviethung]

Gửi Voda và các bạn!

Trong 2 file mẫu bạn gởi, không có sheet nào có dữ liệu từ dòng 5 đến 31 ở cột F. Vậy theo yêu cầu là không copy sheet nào cả! Bạn kiểm tra lại thử. Nếu yêu cầu không rõ, các bạn trên diễn đàn khó giúp bạn.

ohưa nghĩ ra cachiề tư
Mình xin lỗi, kiểm tra sheet trống, chứa hình vẽ (chỉ cần kiểm tra cột H, H5->H31 có Dl hay không ). Nếu không có DL sẽ không copy vao File Hung1.xls. Voda xem lại giúp mình nhé, đoạn code tách chữ số sao vẫn chưa ổn ra một số sheet khi chạy macro tách nó tách được nhưng 1 bên là kiểu ngày tháng, 1 bên kiểu số mặc dù dữ liệu ban đầu là kiểu số.
Voda, các bạn quan sát kỹ nhé. Chạy 1 số sheet vẫn chưa tách hẳn được, và tách nhưng ra kiểu ngày tháng(thường bị ở dòng 18 hoăc 19) như sheet có tên Lo12 trong File Bieu6_Bacninh_TPBacninh ấy. Mình gửi lại File dưới đây, thanks các bạn giúp đỡ!

 

[voda]

Nguyên nhân của những lỗi trên là:
-Trong các sheet, định dạng không thống nhất. Trong vùng dữ liệu cần tách, 2 ô kế tiếp có lúc được merge, có lúc không. Code chạy sai trong trường hợp ô không merge.
-Ô ở dòng 18 chạy sai vì ô này định dạng date. Bạn định dạng lại cho thống nhất code sẽ chạy đúng.

 

[voda]

Bạn thử dùng đoạn code sau:

Option Explicit
Sub Copy_SheetFile()
Dim FolderName As String, wbName As String, MyPath As String
Dim shtSheet As Worksheet
Dim BaseBook As Workbook
Dim sFile As Integer
On Error Resume Next
Set BaseBook = ThisWorkbook
MyPath = ThisWorkbook.Path
wbName = Dir(MyPath & "\" & "*.xls")
Application.ScreenUpdating = False
While wbName <> ""
    If wbName <> "Hung1.xls" Then
        Workbooks.Open (MyPath & "\" & wbName)
          For Each shtSheet In Worksheets
            If WorksheetFunction.Count(shtSheet.Range("H5:H31")) > 0 Then
                BaseBook.Activate
                BaseBook.Worksheets.Add After:=Sheets(Sheets.Count)
                  sFile = sFile + 1
                ActiveSheet.Name = sFile
                shtSheet.Cells.Copy
                BaseBook.ActiveSheet.Paste
            End If
          Next
           Application.CutCopyMode = False
        Workbooks(wbName).Close
      End If
        wbName = Dir
 Wend
Application.ScreenUpdating = True
End Sub