Giúp em tách sheet thành các file riêng

Liên hệ QC

tuancampha

Thành viên mới
Tham gia
24/11/09
Bài viết
9
Được thích
0
Em có một file đính kèm thế này. E muốn tách 5 sheet trong file này ra thành 5 file riêng rẽ một cách nhanh nhất thì thế nào ạ. Tại vì em có hơn 1000 file như thế này, làm thủ công mà tách thì không biết đến bao giờ mới xong. Nhanh được chút nào thì hay chút ấy ạ. Mà nếu tách được ra thành 5 file mới đấy mà đặt tên được luôn cho nó thì càng tốt ạ.
 

File đính kèm

  • Bong 1 N Mau Phieu.xls
    64 KB · Đọc: 177
Lần chỉnh sửa cuối:
Em có một file đính kèm thế này. E muốn tách 12 sheet trong file này ra thành 12 file riêng rẽ một cách nhanh nhất thì thế nào ạ. Tại vì em có hơn 1000 file như thế này, làm thủ công mà tách thì không biết đến bao giờ mới xong. Nhanh được chút nào thì hay chút ấy ạ.
Do bạn post bài ở hai nơi nên mọi người phải chờ xem Mod xóa bài nào rồi mới trả lời giúp bạn. Nếu không trả lời rồi Mod xóa mất lại mất công.
Muốn post nhiều cho nhanh hóa ra lại chậm hơn nhỉ. Lần sau rút kinh nghiệm nhé.
http://www.giaiphapexcel.com/forum/showthread.php?47865-Giúp-em-tách-sheet-thành-các-file-riêng
 
Upvote 0
không phải em post nhiều cho nhanh đâu ạ. Tại vì bài kia em chưa đính kèm file được, mà em không biết xoá nó đi kiểu gì nên mới thế :(. Mọi người có giúp em thì post luôn vào đây, bên kia không có file đính kèm thì thôi ạ
 
Lần chỉnh sửa cuối:
Upvote 0
không phải em post nhiều cho nhanh đâu ạ. Tại vì bài kia em chưa đính kèm file được, mà em không biết xoá nó đi kiểu gì nên mới thế :(. Mọi người có giúp em thì post luôn vào đây, bên kia không có file đính kèm thì thôi ạ
Làm cho bạn luôn đây. Nhớ test trước khi làm thật nha.
PHP:
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Thoat
Dim FileItem As Scripting.File, FolderItem As Scripting.Folder, Obj As Variant, Sh As Worksheet, XoaFile As Boolean
    With Application.FileDialog(4)
        .Show: .AllowMultiSelect = False
        Set Obj = CreateObject("Scripting.FileSystemObject")
        Set FolderItem = Obj.GetFolder(.SelectedItems(1))
    End With
XoaFile = (MsgBox("Ban co muon xoa file goc sau khi tach khong?", vbYesNo) = 6)
On Error Resume Next
    For Each FileItem In FolderItem.Files
    With Workbooks.Open(Filename:=FileItem.Path)
        For Each Sh In .Sheets
            Sh.Copy
            ActiveWorkbook.SaveAs Filename:=FolderItem.Path & "\" & Obj.GetBaseName(.FullName) & "-" & Sh.Name
            ActiveWorkbook.Close
        Next
    .Close
    If XoaFile Then Obj.DeleteFile FileItem.Path, True
    End With
    Next
Thoat:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
Nhờ Mod xóa giùm bài ở đây
 

File đính kèm

  • TachSheet.xls
    42.5 KB · Đọc: 425
Upvote 0
Em test được rồi anh ạ, e cảm ơn nhiều nhé. Khi nào có lỗi phát sinh em lại hỏi tiếp :D
 
Upvote 0
Sửa lại một chút đề phòng trường hợp có sheet ẩn.
PHP:
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Thoat
Dim FileItem As Scripting.File, FolderItem As Scripting.Folder, Obj As Variant, Sh As Worksheet, XoaFile As Boolean
    With Application.FileDialog(4)
        .Show: .AllowMultiSelect = False
        Set Obj = CreateObject("Scripting.FileSystemObject")
        Set FolderItem = Obj.GetFolder(.SelectedItems(1))
    End With
XoaFile = (MsgBox("Ban co muon xoa file goc sau khi tach khong?", vbYesNo) = 6)
On Error Resume Next
    For Each FileItem In FolderItem.Files
    With Workbooks.Open(Filename:=FileItem.Path)
        For Each Sh In .Sheets
            Sh.Visible = -1
            Sh.Copy
            ActiveWorkbook.SaveAs Filename:=FolderItem.Path & "\" & Obj.GetBaseName(.FullName) & "-" & Sh.Name
            ActiveWorkbook.Close
        Next
    .Close
    If XoaFile Then Obj.DeleteFile FileItem.Path, True
    End With
    Next
Thoat:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • TachSheet.xls
    44 KB · Đọc: 465
Upvote 0
A chu đáo quá. Sau đợt này em về em cũng học thêm cái món lập trình này cho biết :D
 
Upvote 0
Dear anh huuthang_bd

Down file tachsheet rồi làm sao tách được anh có thể chỉ chi tiết được ko?
 
Upvote 0
Làm cho bạn luôn đây. Nhớ test trước khi làm thật nha.
PHP:
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Thoat
Dim FileItem As Scripting.File, FolderItem As Scripting.Folder, Obj As Variant, Sh As Worksheet, XoaFile As Boolean
    With Application.FileDialog(4)
        .Show: .AllowMultiSelect = False
        Set Obj = CreateObject("Scripting.FileSystemObject")
        Set FolderItem = Obj.GetFolder(.SelectedItems(1))
    End With
XoaFile = (MsgBox("Ban co muon xoa file goc sau khi tach khong?", vbYesNo) = 6)
On Error Resume Next
    For Each FileItem In FolderItem.Files
    With Workbooks.Open(Filename:=FileItem.Path)
        For Each Sh In .Sheets
            Sh.Copy
            ActiveWorkbook.SaveAs Filename:=FolderItem.Path & "\" & Obj.GetBaseName(.FullName) & "-" & Sh.Name
            ActiveWorkbook.Close
        Next
    .Close
    If XoaFile Then Obj.DeleteFile FileItem.Path, True
    End With
    Next
Thoat:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
Nhờ Mod xóa giùm bài ở đây
Bác ơi. Em dùng Code này mở trên excel 2007 thì nó tách ra đuôi dạng .Xlsx, dùng 2003 nó tách ra dạng .Xls. Có cách nào sử code để chỉ lưu dạng 2003 (.xls) không ah. Thanks
 
Upvote 0
Bác ơi. Em dùng Code này mở trên excel 2007 thì nó tách ra đuôi dạng .Xlsx, dùng 2003 nó tách ra dạng .Xls. Có cách nào sử code để chỉ lưu dạng 2003 (.xls) không ah. Thanks
Bạn copy đoạn code này thay cho code bên trên rồi chạy lại thử nhé !
PHP:
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Thoat
Dim FileItem As Scripting.File, FolderItem As Scripting.Folder, Obj As Variant, Sh As Worksheet, XoaFile As Boolean
    With Application.FileDialog(4)
        .Show: .AllowMultiSelect = False
        Set Obj = CreateObject("Scripting.FileSystemObject")
        Set FolderItem = Obj.GetFolder(.SelectedItems(1))
    End With
XoaFile = (MsgBox("Ban co muon xoa file goc sau khi tach khong?", vbYesNo) = 6)
On Error Resume Next
    For Each FileItem In FolderItem.Files
    With Workbooks.Open(Filename:=FileItem.Path)
        For Each Sh In .Sheets
            Sh.Copy
            ActiveWorkbook.SaveAs Filename:=FolderItem.Path & "\" & Obj.GetBaseName(.FullName) & "-" & Sh.Name & ".xls", FileFormat:=xlExcel8
            ActiveWorkbook.Close
        Next
    .Close
    If XoaFile Then Obj.DeleteFile FileItem.Path, True
    End With
    Next
Thoat:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
Code anh @huuthang_bd mình có thêm đoạn:
& ".xls", FileFormat:=xlExcel8
 
Upvote 0
Bạn copy đoạn code này thay cho code bên trên rồi chạy lại thử nhé !
PHP:
Sub Test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Thoat
Dim FileItem As Scripting.File, FolderItem As Scripting.Folder, Obj As Variant, Sh As Worksheet, XoaFile As Boolean
    With Application.FileDialog(4)
        .Show: .AllowMultiSelect = False
        Set Obj = CreateObject("Scripting.FileSystemObject")
        Set FolderItem = Obj.GetFolder(.SelectedItems(1))
    End With
XoaFile = (MsgBox("Ban co muon xoa file goc sau khi tach khong?", vbYesNo) = 6)
On Error Resume Next
    For Each FileItem In FolderItem.Files
    With Workbooks.Open(Filename:=FileItem.Path)
        For Each Sh In .Sheets
            Sh.Copy
            ActiveWorkbook.SaveAs Filename:=FolderItem.Path & "\" & Obj.GetBaseName(.FullName) & "-" & Sh.Name & ".xls", FileFormat:=xlExcel8
            ActiveWorkbook.Close
        Next
    .Close
    If XoaFile Then Obj.DeleteFile FileItem.Path, True
    End With
    Next
Thoat:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub
Code anh @huuthang_bd mình có thêm đoạn:
Vâng. Cảm ơn anh nhé.
 
Upvote 0
Chào các bác em mới tham gia diễn đàn, nhưng kiến thức về VBA thì em không biết nhiều. Em muốn quản lý dữ liệu kiểm tra bằng file mền. Vì hiện tại chỗ của em đang quản lý toàn bằng file cứng khi tìm lại mất nhiều thời gian, và tốn chỗ để. Vậy em muốn lập thành các file mềm, khi nhập dữ liệu và lưu lại theo ngày, khi cần có thể tim theo ngày tháng in ra để gửi cho khách hàng. File em muốn làm là các check sheet kiểm tra, phần tiêu chuẩn là cố định không được sửa và chỉ được nhập kết quả đo khi thực hiện. Các bác giúp em với, cảm ơn các bác
 
Upvote 0
Chào các bác em mới tham gia diễn đàn, nhưng kiến thức về VBA thì em không biết nhiều. Em muốn quản lý dữ liệu kiểm tra bằng file mền. Vì hiện tại chỗ của em đang quản lý toàn bằng file cứng khi tìm lại mất nhiều thời gian, và tốn chỗ để. Vậy em muốn lập thành các file mềm, khi nhập dữ liệu và lưu lại theo ngày, khi cần có thể tim theo ngày tháng in ra để gửi cho khách hàng. File em muốn làm là các check sheet kiểm tra, phần tiêu chuẩn là cố định không được sửa và chỉ được nhập kết quả đo khi thực hiện. Các bác giúp em với, cảm ơn các bác
Góp ý cho bạn:
1/ Bạn mở Topic mới với 1 File mẫu (file cứng) kèm theo là File chứa dữ liệu theo dõi.
2/ Theo tôi nghĩ chẳng cần lưu File làm gì cả (chỉ tốn dung lượng và tốn công tìm kiếm), chỉ cần thiết kế 1 sheet mẫu như (file cứng) rồi lưu những thứ cần vào sheet theo dõi.
3/ Nếu cần in cái gì đó thì dựa vào sheet theo dõi có thể truy vấn và in hàng loạt (bạn không đính kèm File nên chịu thua), chẳng hiểu bạn muốn làm cái gì? Ở đâu?
 
Upvote 0
Xin lỗi các bác em chưa nói rõ. Em gửi các bác file đính kèm, file này bình thường em in ra file cứng. Khi kiểm tra em phải điền các thông tin liên quan đến mã sản phẩm này và ghi kết quả đo vào vùng ô mầu vàng, sau đó lưu vào một file để vào trong tủ. Khi muốn tìm em phải tìm từng file cứng một rất là nâu, Vì một ngày em phải kiểm tra rất nhiều mã và nhiều sản phẩm khác nhau, có khi dữ liệu sau một tháng hoặc hai tháng mới tìm lại vì vậy là rất kho khăn khi tìm dữ liệu. Vậy em nhờ các bác giúp em giúp bài toán này
1. Lưu file dưới dạng file mềm: Vùng ô mầu trắng là tiêu chuẩn không cho phép sửa. Khi kiểm tra chỉ được nhập dữ liệu vào ô mầu vàng
2. Khi ấn vào nút "lưu dữ liệu" thì tên file sẽ tự động lưu theo ngày và giờ trên máy tính
3. Khi file được lưu thì không cho phép sửa dữ liệu khi mở ra
4. Khi mở file nguồn ra để nhập dữ liễu cho lần kiểm tra tiếp theo thì dữ liệu trước đó ở ô mầu vàng phải clear hết.
Cảm ơn các bác
 

File đính kèm

  • VHS1A1765.xls
    106.5 KB · Đọc: 20
Upvote 0
Xin lỗi các bác em chưa nói rõ. Em gửi các bác file đính kèm, file này bình thường em in ra file cứng. Khi kiểm tra em phải điền các thông tin liên quan đến mã sản phẩm này và ghi kết quả đo vào vùng ô mầu vàng, sau đó lưu vào một file để vào trong tủ. Khi muốn tìm em phải tìm từng file cứng một rất là nâu, Vì một ngày em phải kiểm tra rất nhiều mã và nhiều sản phẩm khác nhau, có khi dữ liệu sau một tháng hoặc hai tháng mới tìm lại vì vậy là rất kho khăn khi tìm dữ liệu. Vậy em nhờ các bác giúp em giúp bài toán này
1. Lưu file dưới dạng file mềm: Vùng ô mầu trắng là tiêu chuẩn không cho phép sửa. Khi kiểm tra chỉ được nhập dữ liệu vào ô mầu vàng
2. Khi ấn vào nút "lưu dữ liệu" thì tên file sẽ tự động lưu theo ngày và giờ trên máy tính
3. Khi file được lưu thì không cho phép sửa dữ liệu khi mở ra
4. Khi mở file nguồn ra để nhập dữ liễu cho lần kiểm tra tiếp theo thì dữ liệu trước đó ở ô mầu vàng phải clear hết.
Cảm ơn các bác
Như nội dung góp ý cho bạn tại bài 14:
1/ Bạn mở Topic mới với Tiêu đề là "Dùng SheetForm để lưu dữ liệu vào sheet theo dõi".
2/ Đính kèm File với mẫu FORM và 1 sheet theo dõi có tiêu đề đầy đủ.
3/ Chẳng cần lưu File gì cả (đọc lại , 3 của bài 4 để hiểu).
 
Upvote 0
Cảm ơn bác be09 đã tư vân giúp em. Bác giúp lập một file mẫu được không ạ, vì em chẳng hiểu gì về VBA cả
Cảm ơn bác
 
Upvote 0
Web KT
Back
Top Bottom