Xuất sheet sang file

lp0072021 · 19/12/23

Chào anh chị,
Em có file "Xuatfile" gồm 4 sheet nhờ anh chị giúp em code để xuất 4 sheet đó thành 4 file mới lưu ở cùng thư mục đang chứa "Xuatfile" với tên file tương ứng với tên của 4 sheet. Em cảm ơn các anh chị.

tieutuvodanh192 · 19/12/23

lp0072021 đã viết:
Chào anh chị,
Em có file "Xuatfile" gồm 4 sheet nhờ anh chị giúp em code để xuất 4 sheet đó thành 4 file mới lưu ở cùng thư mục đang chứa "Xuatfile" với tên file tương ứng với tên của 4 sheet. Em cảm ơn các anh chị.

Bạn kiểm tra lại xem đúng ý chưa nha.

Mã:

Sub TachFileExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws As Worksheet
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
For Each ws In ThisWorkbook.Sheets
        ws.Copy
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

lp0072021 · 19/12/23

tieutuvodanh192 đã viết:

Bạn kiểm tra lại xem đúng ý chưa nha.

Mã:

Sub TachFileExcel()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws As Worksheet
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
For Each ws In ThisWorkbook.Sheets
        ws.Copy
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Đúng rồi bạn, trường hợp mình xuất ra file excel lưu ở dạng Microsoft Excel 5.0/95 Workbook thì sửa lại thế nào vậy bạn. bạn giúp mình với.

tieutuvodanh192 · 19/12/23

lp0072021 đã viết:
Đúng rồi bạn, trường hợp mình xuất ra file excel lưu ở dạng Microsoft Excel 5.0/95 Workbook thì sửa lại thế nào vậy bạn. bạn giúp mình với.

Bạn vào code tìm dòng bên dưới sửa ".xlsx" thành ".xls" thử xem.

Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"

lp0072021 · 19/12/23

tieutuvodanh192 đã viết:
Bạn vào code tìm dòng bên dưới sửa ".xlsx" thành ".xls" thử xem.

Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"

MÌnh sửa chỗ đó rồi nhưng nó lại ra excel 97-2003 bạn

tieutuvodanh192 · 19/12/23

lp0072021 đã viết:
MÌnh sửa chỗ đó rồi nhưng nó lại ra excel 97-2003 bạn

Nếu vậy thì bạn thử lại mã code này xem sao:

Mã:

Sub TachFileExcel()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim ws As Worksheet
    Dim FPath As String
    FPath = Application.ActiveWorkbook.Path
    
    For Each ws In ThisWorkbook.Sheets
        ws.Copy
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xls", FileFormat:=xlExcel5
        Application.ActiveWorkbook.Close False
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

HUONGHCKT · 19/12/23

lp0072021 đã viết:
Chào anh chị,
Em có file "Xuatfile" gồm 4 sheet nhờ anh chị giúp em code để xuất 4 sheet đó thành 4 file mới lưu ở cùng thư mục đang chứa "Xuatfile" với tên file tương ứng với tên của 4 sheet. Em cảm ơn các anh chị.

Góp vui, bạn chủ thớt tham khảo thêm
Khi Xuất sang các file mới, nhưng các file ấy đã có rồi thì sao: Ghi đè hay bỏ qua. Code dưới đây sẽ hỏi bạn và tùy bạn quyết định.

Mã:

Option Explicit

Sub TachShThanhFile()
Dim Ws As Worksheet, Sh As Worksheet, Wb As Workbook
Dim Ten As String
Dim aPath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

aPath = Application.ThisWorkbook.Path
For Each Ws In Worksheets
    Ten = Ws.Name
    If FileExists(aPath & "\" & Ten & ".xlsx") = False Then
        Ws.Cells.Copy
        Workbooks.Add
        ActiveSheet.Paste
        Set Sh = ActiveSheet
        Sh.Name = Ten
        ActiveWorkbook.SaveAs Filename:=aPath & "\" & Ten & ".xlsx"
        ActiveWorkbook.Close
    Else
        If MsgBox("File này da có, ban muôn ghi dè không?", vbYesNo + vbCritical, "THÔNG BÁO") = vbYes Then
            Workbooks.Open (aPath & "\" & Ten & ".xlsx")
            Ws.Cells.Copy Sheets(Ten).Range("A1")
            ActiveWorkbook.Save
            ActiveWorkbook.Close
        End If
    End If
Next Ws
MsgBox "Done"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Code trên có sử dụng hàm UDF kiểm tra sự tồn tại của file (của 1 anh nào đó trên diễn đàn này-tôi không nhớ tên)
Xem file

lp0072021 · 19/12/23

HUONGHCKT đã viết:
Góp vui, bạn chủ thớt tham khảo thêm
Khi Xuất sang các file mới, nhưng các file ấy đã có rồi thì sao: Ghi đè hay bỏ qua. Code dưới đây sẽ hỏi bạn và tùy bạn quyết định.

Mã:

Option Explicit Sub TachShThanhFile() Dim Ws As Worksheet, Sh As Worksheet, Wb As Workbook Dim Ten As String Dim aPath As String Application.ScreenUpdating = False Application.DisplayAlerts = False aPath = Application.ThisWorkbook.Path For Each Ws In Worksheets Ten = Ws.Name If FileExists(aPath & "\" & Ten & ".xlsx") = False Then Ws.Cells.Copy Workbooks.Add ActiveSheet.Paste Set Sh = ActiveSheet Sh.Name = Ten ActiveWorkbook.SaveAs Filename:=aPath & "\" & Ten & ".xlsx" ActiveWorkbook.Close Else If MsgBox("File này da có, ban muôn ghi dè không?", vbYesNo + vbCritical, "THÔNG BÁO") = vbYes Then Workbooks.Open (aPath & "\" & Ten & ".xlsx") Ws.Cells.Copy Sheets(Ten).Range("A1") ActiveWorkbook.Save ActiveWorkbook.Close End If End If Next Ws MsgBox "Done" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

Code trên có sử dụng hàm UDF kiểm tra sự tồn tại của file (của 1 anh nào đó trên diễn đàn này-tôi không nhớ tên)
Xem file

Trường hợp mình chỉ chọn xuất một số sheet nào đó mà không chọn hết thì làm thế nào bản nhỉ. cảm ơn bạn.

HUONGHCKT · 19/12/23

lp0072021 đã viết:
Trường hợp mình chỉ chọn xuất một số sheet nào đó mà không chọn hết thì làm thế nào bản nhỉ. cảm ơn bạn.

Code của tôi bạn chạy tháy đúng ý không?
Bạn đã thử các trường họp đã có tên file trùng với tên Sheet cần chuyể thành file chưa?
Còn về
1/nếu số Sheet không muốn chuyển thành file it thì có thể liệt kê như trên cho đến hết thì:

Mã:

For Each Ws In Worksheets
If Ws.name<> "Ten Sheet không chuyển thành file" Or Ws.name<>"Ten Sheet không chuyển thành file" or Ws.name<>.......    then
.....
....
end if
next Ws

1.a/ hoặc thay dấu "<>" thành dấu "="

Mã:

For Each Ws In Worksheets
If Ws.name="Ten Sheet muốn chuyển thành file" Or Ws.name="Ten Sheet muốn chuyển thành file" or Ws.name<>.......    then
.....
....
end if
next Ws

2/nếu nhiều thì đưa tên các sheet ấy vào 1 array (mảng ) và dùng vòng lặp duyệt từng phần tử của mảng Array ấy (chính là tên các sheet) :

Mã:

 Mang=Array("VND", "USD", "France", "YenNhat", "CNN",......) 
For Each Ws In Worksheets
 for i = LBound(Mang) to Ubound(mang)
if Ws.name <> Mang(i) then
......
...
End if
next i
next Ws

2.a/Khi số sheet cần chuyển ít hơn số Sheet không cần chuyển bạn vận dụng trường hợp 1.a ở trên code sẽ ngắn hơn.
Chúc bạn thành công.

lp0072021 · 19/12/23

HUONGHCKT đã viết:
Code của tôi bạn chạy tháy đúng ý không?
Bạn đã thử các trường họp đã có tên file trùng với tên Sheet cần chuyể thành file chưa?
Còn về
1/nếu số Sheet không muốn chuyển thành file it thì có thể liệt kê như trên cho đến hết thì:

Mã:

For Each Ws In Worksheets If Ws.name<> "Ten Sheet không chuyển thành file" Or Ws.name<>"Ten Sheet không chuyển thành file" or Ws.name<>....... then ..... .... end if next Ws

1.a/ hoặc thay dấu "<>" thành dấu "="

Mã:

For Each Ws In Worksheets If Ws.name="Ten Sheet muốn chuyển thành file" Or Ws.name="Ten Sheet muốn chuyển thành file" or Ws.name<>....... then ..... .... end if next Ws

2/nếu nhiều thì đưa tên các sheet ấy vào 1 array (mảng ) và dùng vòng lặp duyệt từng phần tử của mảng Array ấy (chính là tên các sheet) :

Mã:

Mang=Array("VND", "USD", "France", "YenNhat", "CNN",......) For Each Ws In Worksheets for i = LBound(Mang) to Ubound(mang) if Ws.name <> Mang(i) then ...... ... End if next i next Ws

2.a/Khi số sheet cần chuyển ít hơn số Sheet không cần chuyển bạn vận dụng trường hợp 1.a ở trên code sẽ ngắn hơn.
Chúc bạn thành công.

Mình chạy thấy đúng có báo trùng tên file đã tồn tại, nhưng bạn sửa giúp mình lưu ở dạng Microsoft Excel 5.0/95 Workbook

HUONGHCKT · 19/12/23

lp0072021 đã viết:
Mình chạy thấy đúng có báo trùng tên file đã tồn tại, nhưng bạn sửa giúp mình lưu ở dạng Microsoft Excel 5.0/95 Workbook

Hỏi vui bạn tý chút, để thư giãn: Bạn đã bao giờ dắt voi đi gặp 2 bà Trưng chưa?
Trở lại với đề bài của bạn: xin hỏi lại bạn là Sao bạn không lưu file với tiền tố ".xlsx" hay ".xlsm" hay ".xlsb". Lưu ở các dạng này dung file sẽ ít hơn còn tác dụng, tác hại của nó thế nào thì tôi không rõ(do không có căn bản), nhưng tôi vẫn tin rằng : đời Ex cao hơn sẽ có nhiều tính năng hơn (số dòng số cột nhiều hơn).
Nếu muốn nó có đuôi như nói trên thì: chỉ cần thay chỗ Ten & ".xlsx" thành Ten & ".xlsm", hay "xlsb",...
Còn đáp án của tôi cho đề bài của bạnlà :
Bạn tìm đến dòng : ActiveWorkbook.SaveAs Filename:=aPath & "\" & Ten & ".xlsx"
và thay nó thành
ActiveWorkbook.SaveAs Filename:=aPath & "\" & Ten & ".xls", FileFormat:=xlExcel5, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Trên máy tôi code chạy êm, Đuôi của file là ".xls" và phần type là Microsort excel 95.
Bạn tìm hiểu thêm nhé.

Xuất sheet sang file

lp0072021

Thành viên chính thức

File đính kèm

tieutuvodanh192

Thành viên thường trực

File đính kèm

lp0072021

Thành viên chính thức

tieutuvodanh192

Thành viên thường trực

lp0072021

Thành viên chính thức

tieutuvodanh192

Thành viên thường trực

HUONGHCKT

Zalo 0986997214

File đính kèm

lp0072021

Thành viên chính thức

HUONGHCKT

Zalo 0986997214

lp0072021

Thành viên chính thức

HUONGHCKT

Zalo 0986997214

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng