kiến thức [Excel VBA] Tách từng sheet trong một file Excel thành một file riêng lẻ

NguyenDang95

NguyenDang95

Senior Member
Chào mọi người. Trong quá trình làm việc, một số người dùng muốn tách từng sheet trong một file Excel thành một file riêng lẻ để phục vụ nhiều mục đích khác nhau. Nếu file có vài ba sheet cần tách thì có thể thao tác thủ công, nhưng nếu có vài chục sheet cần tách thì lúc này macro sẽ giúp chúng ta giải quyết việc này một cách nhanh chóng.
Macro dưới đây sẽ:
  • Đọc từng sheet trong file Excel cần thao tác.
  • Dùng phương thức Sheets.Copy sẽ khiến Excel tạo một workbook riêng chứa sheet đang đọc
  • Lưu workbook mới vừa tạo với tên sheet đang đọc, sau đó đóng workbook mới đó
Code: 
Option Explicit

Private Sub ExportMultipleSheets()
    Dim objWb As Excel.Workbook
    Dim objNewWb As Excel.Workbook
    Dim objSheets As Excel.Sheets
    Dim objSheet As Excel.Worksheet
    Dim objNewSheet As Excel.Worksheet
    Dim strExportFolder As String
    Dim strSheetName As String
    Dim lngSheetCount As Long
   
    strExportFolder = "C:\ExportFolder\" 'Thư mục xuất file ra
    lngSheetCount = 0
    Set objWb = ActiveWorkbook
    Set objSheets = objWb.Sheets
    For Each objSheet In objSheets
        strSheetName = strExportFolder & objSheet.Name & ".xlsx"
        objSheet.Copy
        Set objNewWb = ActiveWorkbook
        Set objNewSheet = objNewWb.ActiveSheet
        objNewSheet.SaveAs Filename:=strSheetName, FileFormat:=xlOpenXMLWorkbook
        objNewWb.Close SaveChanges:=False
        strSheetName = ""
        lngSheetCount = lngSheetCount + 1
    Next objSheet
    MsgBox lngSheetCount & " sheet(s) exported successfully.", vbInformation, "Export Complete"
    Set objSheets = Nothing
    Set objSheet = Nothing
    Set objNewSheet = Nothing
    Set objWb = Nothing
    Set objNewWb = Nothing
End Sub

Ngoài cách viết macro và chạy trực tiếp trên file Excel, chúng ta có thể viết script VBScript để thao tác với file Excel.
Soạn thảo trong Notepad, lưu lại với phần mở rộng ".vbs".

1644416491367.png


Code: 
Option Explicit
   
    Dim objXl 'As Excel.Application
    Dim objWb 'As Excel.Workbook
    Dim objNewWb 'As Excel.Workbook
    Dim objSheets 'As Excel.Sheets
    Dim objSheet 'As Excel.Worksheet
    Dim objNewSheet 'As Excel.Worksheet
    Dim strExportFolder, strSheetName, strWbName 'As String
    Dim lngSheetCount 'As Long
    Const xlOpenXMLWorkbook = 51
   
    strExportFolder = "C:\ExportFolder\"
    strWbName = strExportFolder & "Book1.xlsm"
    lngSheetCount = 0
    Set objXl = CreateObject("Excel.Application")
    objXl.Visible = True
    Set objWb = objXl.Workbooks.Open(strWbName)
    Set objSheets = objWb.Sheets
    For Each objSheet In objSheets
        strSheetName = strExportFolder & objSheet.Name & ".xlsx"
        objSheet.Copy
        Set objNewWb = objXl.ActiveWorkbook
        Set objNewSheet = objNewWb.ActiveSheet
        objNewSheet.SaveAs strSheetName, xlOpenXMLWorkbook
        objNewWb.Close False
        strSheetName = ""
        lngSheetCount = lngSheetCount + 1
    Next
    objXl.Quit
    MsgBox lngSheetCount & " sheet(s) exported successfully.", vbInformation, "Export Complete"
    Set objXl = Nothing
    Set objSheets = Nothing
    Set objSheet = Nothing
    Set objNewSheet = Nothing
    Set objWb = Nothing
    Set objNewWb = Nothing

Kết quả:

1644416436599.png
 
Last edited:
@NguyenDang95 cho mình nhờ xíu, giả sử file excel của mình có 20 sheet cần set PrintTitle $5:$6 + Filter $6 (dòng thứ 6); 10 sheet cần PrintTitle $4:$5 + Filter $5 ... (các sheet có tên và thứ tự lung tung) thì có Add-in nào xử lý nhanh được ko ợ?
Bình thường mình chọn các sheet cần set roài chạy macro như dưới nhưng thấy hơi bất tiện vì phải nạp khá nhiều marco

Code: 
Attribute VB_Name = "Module1"
Sub PrintTitle 56()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
'For Each ws In ActiveWindow.SelectedSheets
If ws.Type = xlWorksheet Then
ws.PageSetup.PrintTitleRows = "$5:$6"
End If
Next
End Sub
Code: 
Attribute VB_Name = "Module1"
Sub PrintTitle 45()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
'For Each ws In ActiveWindow.SelectedSheets
If ws.Type = xlWorksheet Then
ws.PageSetup.PrintTitleRows = "$4:$5"
End If
Next
End Sub
Code: 
Attribute VB_Name = "Module1"
Sub PrintTitle 33()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
'For Each ws In ActiveWindow.SelectedSheets
If ws.Type = xlWorksheet Then
ws.PageSetup.PrintTitleRows = "$3:$3"
End If
Next
End Sub
 
Last edited:
GR666N said:
@NguyenDang95 cho mình nhờ xíu, giả sử file excel của mình có 20 sheet cần set PrintTitle $5:$6 + Filter $6 (dòng thứ 6); 10 sheet cần PrintTitle $4:$5 + Filter $5 ... (các sheet có tên và thứ tự lung tung) thì có Add-in nào xử lý nhanh được ko ợ?
Bình thường mình chọn các sheet cần set roài chạy macro như dưới nhưng thấy hơi bất tiện vì phải nạp khá nhiều marco

Code: 
Attribute VB_Name = "Module1"
Sub PrintTitle 56()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
'For Each ws In ActiveWindow.SelectedSheets
If ws.Type = xlWorksheet Then
ws.PageSetup.PrintTitleRows = "$5:$6"
End If
Next
End Sub
Code: 
Attribute VB_Name = "Module1"
Sub PrintTitle 45()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
'For Each ws In ActiveWindow.SelectedSheets
If ws.Type = xlWorksheet Then
ws.PageSetup.PrintTitleRows = "$4:$5"
End If
Next
End Sub
Code: 
Attribute VB_Name = "Module1"
Sub PrintTitle 33()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
'For Each ws In ActiveWindow.SelectedSheets
If ws.Type = xlWorksheet Then
ws.PageSetup.PrintTitleRows = "$3:$3"
End If
Next
End Sub
Click to expand...
Theo trình bày của thím thì em có ý tưởng thế này, tạo một Userform, chọn những sheet cần điều chỉnh.

1644569842165.png


Không biết đã đúng ý thím chưa nhỉ.
 
NguyenDang95 said:
Chào mọi người. Trong quá trình làm việc, một số người dùng muốn tách từng sheet trong một file Excel thành một file riêng lẻ để phục vụ nhiều mục đích khác nhau. Nếu file có vài ba sheet cần tách thì có thể thao tác thủ công, nhưng nếu có vài chục sheet cần tách thì lúc này macro sẽ giúp chúng ta giải quyết việc này một cách nhanh chóng.
Macro dưới đây sẽ:
  • Đọc từng sheet trong file Excel cần thao tác.
  • Dùng phương thức Sheets.Copy sẽ khiến Excel tạo một workbook riêng chứa sheet đang đọc
  • Lưu workbook mới vừa tạo với tên sheet đang đọc, sau đó đóng workbook mới đó
Code: 
Option Explicit

Private Sub ExportMultipleSheets()
    Dim objWb As Excel.Workbook
    Dim objNewWb As Excel.Workbook
    Dim objSheets As Excel.Sheets
    Dim objSheet As Excel.Worksheet
    Dim objNewSheet As Excel.Worksheet
    Dim strExportFolder As String
    Dim strSheetName As String
    Dim lngSheetCount As Long
  
    strExportFolder = "C:\ExportFolder\" 'Thư mục xuất file ra
    lngSheetCount = 0
    Set objWb = ActiveWorkbook
    Set objSheets = objWb.Sheets
    For Each objSheet In objSheets
        strSheetName = strExportFolder & objSheet.Name & ".xlsx"
        objSheet.Copy
        Set objNewWb = ActiveWorkbook
        Set objNewSheet = objNewWb.ActiveSheet
        objNewSheet.SaveAs Filename:=strSheetName, FileFormat:=xlOpenXMLWorkbook
        objNewWb.Close SaveChanges:=False
        strSheetName = ""
        lngSheetCount = lngSheetCount + 1
    Next objSheet
    MsgBox lngSheetCount & " sheet(s) exported successfully.", vbInformation, "Export Complete"
    Set objSheets = Nothing
    Set objSheet = Nothing
    Set objNewSheet = Nothing
    Set objWb = Nothing
    Set objNewWb = Nothing
End Sub

Ngoài cách viết macro và chạy trực tiếp trên file Excel, chúng ta có thể viết script VBScript để thao tác với file Excel.
Soạn thảo trong Notepad, lưu lại với phần mở rộng ".vbs".

View attachment 1009442

Code: 
Option Explicit
  
    Dim objXl 'As Excel.Application
    Dim objWb 'As Excel.Workbook
    Dim objNewWb 'As Excel.Workbook
    Dim objSheets 'As Excel.Sheets
    Dim objSheet 'As Excel.Worksheet
    Dim objNewSheet 'As Excel.Worksheet
    Dim strExportFolder, strSheetName, strWbName 'As String
    Dim lngSheetCount 'As Long
    Const xlOpenXMLWorkbook = 51
  
    strExportFolder = "C:\ExportFolder\"
    strWbName = strExportFolder & "Book1.xlsm"
    lngSheetCount = 0
    Set objXl = CreateObject("Excel.Application")
    objXl.Visible = True
    Set objWb = objXl.Workbooks.Open(strWbName)
    Set objSheets = objWb.Sheets
    For Each objSheet In objSheets
        strSheetName = strExportFolder & objSheet.Name & ".xlsx"
        objSheet.Copy
        Set objNewWb = objXl.ActiveWorkbook
        Set objNewSheet = objNewWb.ActiveSheet
        objNewSheet.SaveAs strSheetName, xlOpenXMLWorkbook
        objNewWb.Close False
        strSheetName = ""
        lngSheetCount = lngSheetCount + 1
    Next
    objXl.Quit
    MsgBox lngSheetCount & " sheet(s) exported successfully.", vbInformation, "Export Complete"
    Set objXl = Nothing
    Set objSheets = Nothing
    Set objSheet = Nothing
    Set objNewSheet = Nothing
    Set objWb = Nothing
    Set objNewWb = Nothing

Kết quả:

View attachment 1009441
Click to expand...
Muốn học vba thì trước hết phải thật rành excel đã hả bác
 
GR666N said:
à load F5. mình test cách này ok cơ mà thao tác chọn sheet thủ công quá, có thể cải tiến thành như ảnh hay fix cho noá chọn sheet nhanh hơn ko thym

View attachment 1012031
Click to expand...
Gửi lại thím file Add-in nhé.
Em có thiết kế lại Userform như hình dưới.
1644580646178.png


Để hiển thị trên ribbon, trong file Add-in có macro CmdBars, khi thím chạy nó xong, trên ribbon sẽ hiện ra một tab Add-ins như hình dưới (cái toolbar này nhìn hơi phèn :big_smile: , mà muốn đẹp thì phải vọc file .xml của Excel nhức đầu lắm. :beat_shot: )
1644581056999.png
 

Attachments

  • PrintTitlesRows.zip
    19.5 KB · Views: 53
@NguyenDang95 thym ơi, mình vừa test chọn nhiều sheet rồi chạy add-in thì chỉ có sheet đầu tiên là được set print title với cả add-in hơi lệch ý mình
Ý tưởng là trong Group Print Title sẽ có 2 nút
  • Chọn/set title rows (bấm vào sẽ hiển ra cái bảng để nhập row vd $3:$3; $4:$5; $5:$6...)
  • Chạy/run
P/s: tương tự với cái [Filter]

1644631820565.png


1644631598104.png
 
GR666N said:
@NguyenDang95 thym ơi, mình vừa test chọn nhiều sheet rồi chạy add-in thì chỉ có sheet đầu tiên là được set print title với cả add-in hơi lệch ý mình
Ý tưởng là trong Group Print Title sẽ có 2 nút
  • Chọn/set title rows (bấm vào sẽ hiển ra cái bảng để nhập row vd $3:$3; $4:$5; $5:$6...)
  • Chạy/run
P/s: tương tự với cái [Filter]

View attachment 1012756

View attachment 1012747
Click to expand...
Theo ý tưởng của thím, em có thiết kế như thế này:
  • Thím bấm chọn macro trên ribbon, hiển thị một cái bảng nhập giá trị Print Title Rows cho những sheet mà thím chọn ở dưới. Bấm nút chạy sẽ ra kết quả kèm theo hộp thoại như hình dưới.
    1644639229245.png
  • Cái menu ribbon này em không thể đưa vào trong Add-in được, có gì thím tự thiết kế nhé.
    1644639876536.png
Gửi thím file Add-in. Có gì cần bổ sung thím báo em nhé.
 

Attachments

  • PrintTitleRows_MultipleSheets.zip
    20.9 KB · Views: 45
Last edited:
Cám ơn thym. đúng cái mình cần đây rồi. thym đổi ShowFrm thành PrintTitle để dễ mò custom ribbon nữa là best luôn :beauty:

P/s: nếu được nhờ thym build thêm add-in tạo nhanh Filter cho đủ bộ và mở thêm 1 thớt giới thiệu + hdsd các addin hay cho mọi người nữa :D
 
Last edited:
GR666N said:
Cám ơn thym. đúng cái mình cần đây rồi. thym đổi ShowFrm thành PrintTitle để dễ mò custom ribbon nữa là best luôn :beauty:

P/s: nếu được nhờ thym build thêm add-in tạo nhanh Filter cho đủ bộ và mở thêm 1 thớt giới thiệu + hdsd các addin hay cho mọi người nữa :D
Click to expand...

Đổi tên được mà thím. :big_smile:
1644659014097.png


"build thêm add-in tạo nhanh Filter" cái này thím giải thích rõ hơn được không.
 

Similar threads

NguyenDang95
kiến thức [Excel VBA] Tự động tạo danh sách liệt kê tất cả các tập tin Excel trong một thư mục nhất định
Replies
9
Views
2K
perepermin
P
NguyenDang95
kiến thức [Excel VBA] Đính kèm sheet hiện tại vào thư mới
Replies
11
Views
2K
khuekin
K
NguyenDang95
kiến thức [Office VBA] Sao lưu hàng loạt macro trong Word, Excel, Powerpoint
Replies
0
Views
702
NguyenDang95
NguyenDang95

Share this page

Back
Top