Chuyển 1 sheet thành 1 file

[Vinix]

Mình có 1 file excel gồm nhiều sheet. Nay muốn xuất 1 sheet thành 1 file riêng biệt, có tên là tên của sheet đó thì phải làm thế nào. Google mấy ngày rùi hok ra. Các bác giúp em với.

 

[chuot0106]

Bạn đã áp dụng được chưa vậy???

 

[nhk007dn]

Sub Macro1()
Workbooks.Add
Dim fso As Object, NewFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewFolder = "D:\CT"
If Not fso.FolderExists(NewFolder) Then
     fso.CreateFolder (NewFolder)
End If
ThisWorkbook.ActiveSheet.Range("A1:AN10000").Copy Workbooks(Workbooks.Count).Sheets(1).Range("A1")
    ChDir "D:\CT"
[COLOR=#ff0000]    Workbooks(Workbooks.Count).SaveAs Filename:="D:\CT\" & Workbooks("CT").ActiveSheet.Name & ".xlsm", FileFormat _[/COLOR]
[COLOR=#ff0000]        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False[/COLOR]
        Workbooks(Workbooks.Count).Close
End Sub

Cảm ơn bạn đã giúp!
Đã hồi âm cho bạn, phần lỗi mình gặp là ở đoạn màu đỏ.

 

[chuot0106]

Sub Macro1()
Workbooks.Add
Dim fso As Object, NewFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")
NewFolder = "D:\CT"
If Not fso.FolderExists(NewFolder) Then
     fso.CreateFolder (NewFolder)
End If
ThisWorkbook.ActiveSheet.Range("A1:AN10000").Copy Workbooks(Workbooks.Count).Sheets(1).Range("A1")
    ChDir "D:\CT"
[COLOR=#ff0000]    Workbooks(Workbooks.Count).SaveAs Filename:="D:\CT\" & Workbooks("CT").ActiveSheet.Name & ".xlsm", FileFormat _[/COLOR]
[COLOR=#ff0000]        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False[/COLOR]
        Workbooks(Workbooks.Count).Close
End Sub

Cảm ơn bạn đã giúp!
Đã hồi âm cho bạn, phần lỗi mình gặp là ở đoạn màu đỏ.

Tên File gốc của bạn có thay đổi không? Tức vẫn là "CT" hay bạn đổi thành File khác? Bạn dùng Office 2003 hay ?

 

[nhk007dn]

Tên File gốc của bạn có thay đổi không? Tức vẫn là "CT" hay bạn đổi thành File khác? Bạn dùng Office 2003 hay ?

Mình test vẫn với tên file 'CT.xlsm' trên excel 2007.

 

[chuot0106]

Mình test vẫn với tên file 'CT.xlsm' trên excel 2007.

Bạn có TeamView ko gửi ID và Pass tôi Test thử xem sao.

 

[ndu96081631]

Xin phép dùng topic cũ này để hỏi về cùng 1 chủ đề lưu sheet
Mình muốn khi chạy code hiện ra bảng chọn đường dẫn và ghi tên file giống chức năng save của MS excel, chỉ khác ở đây là lưu sheet hiện hành ra thành file riêng. (Còn chức năng save của MS excel thì lưu nguyên file excel)
Nhờ các bạn giúp.
Mình cảm ơn!

Vào chỗ này lấy nguyên "cục" về xài luôn cho rồi:
http://www.giaiphapexcel.com/forum/...e-save-as-sheet-hiện-hành&p=531279#post531279
- Chương trình cho phép lưu một hoặc nhiều sheet ra thành file
- Tùy chọn đường dẫn lưu file
- Có thể lưu sheet thành file với nhiều định dạng khác nhau (kể cả lưu thành pdf)
vân vân... và... mây mây

 

[nhk007dn]

Vào chỗ này lấy nguyên "cục" về xài luôn cho rồi:
http://www.giaiphapexcel.com/forum/...e-save-as-sheet-hiện-hành&p=531279#post531279
- Chương trình cho phép lưu một hoặc nhiều sheet ra thành file
- Tùy chọn đường dẫn lưu file
- Có thể lưu sheet thành file với nhiều định dạng khác nhau (kể cả lưu thành pdf)
vân vân... và... mây mây

Chương trình có thể lưu hơn 1 sheet vào thành 1 file được ko vậy anh ndu?
Ví dụ: file gốc có 5 sheet, mình muốn lưu sheet1, sheet2, sheet3 ra thành 1 file riêng thì làm cách nào?
em cảm ơn!

 

[chuot0106]

Chương trình có thể lưu hơn 1 sheet vào thành 1 file được ko vậy anh ndu?
Ví dụ: file gốc có 5 sheet, mình muốn lưu sheet1, sheet2, sheet3 ra thành 1 file riêng thì làm cách nào?
em cảm ơn!

Lưu bao nhiêu Sheet mà chẳng làm được quan trọng là lưu như thế nào? Bạn phải nói rõ ra chứ!

 

[ndu96081631]

Chương trình có thể lưu hơn 1 sheet vào thành 1 file được ko vậy anh ndu?
Ví dụ: file gốc có 5 sheet, mình muốn lưu sheet1, sheet2, sheet3 ra thành 1 file riêng thì làm cách nào?
em cảm ơn!

Thì bạn cứ mở chương trình và thí nghiệm. Bấm nút Help để xem hướng dẫn chi tiết

 

[thanhhaichau]

Bạn đặt con trỏ vào sheet cần tạo. Bấm phải chuột -> Chọn Move or copy -> Trong ô To book chọn new book -> OK

Rất dễ hiểu và rất dễ làm. Cám ơn anh nhiều lắm nhé !

 

[Minh Đức 1309]

Bỏ vòng lặp đi là được:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\Sheet1"
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   
End Sub

NẾU SHEETS BIẾN ĐỘNG THÌ SAO ĐÂY THẦY CHẢ NHẼ CỨ SỬA CODE LIÊN TỤC Ạ

 

[Hai Lúa Miền Tây]

NẾU SHEETS BIẾN ĐỘNG THÌ SAO ĐÂY THẦY CHẢ NHẼ CỨ SỬA CODE LIÊN TỤC Ạ

Vì có người yêu cầu lưu 1 sheet ra 1 file mà bạn. Còn nếu lưu các sheet thì bạn đọc lại bài số 3 nhé.

 

[Minh Đức 1309]

Vì có người yêu cầu lưu 1 sheet ra 1 file mà bạn. Còn nếu lưu các sheet thì bạn đọc lại bài số 3 nhé.

Cảm ơn thầy ạ,thầy ơi em muốn hỏi là mình có file nhiều sheet,e muốn copy 1 sheet trong file đó thành file riêng với tên file đó là gí trị của 1 ô trong sheet.Mong thầy giúp đỡ !!!

 

[Hai Lúa Miền Tây]

Cảm ơn thầy ạ,thầy ơi em muốn hỏi là mình có file nhiều sheet,e muốn copy 1 sheet trong file đó thành file riêng với tên file đó là gí trị của 1 ô trong sheet.Mong thầy giúp đỡ !!!

Code như trên thôi bạn. Ví dụ tôi lưu sheet với tên là Sheet1 thành file mới chung với thư mục file hiện hành, tên file là cell A1 trong sheet1 thì code như sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
  
End Sub

 

[leonguyenz]

Code như trên thôi bạn. Ví dụ tôi lưu sheet với tên là Sheet1 thành file mới chung với thư mục file hiện hành, tên file là cell A1 trong sheet1 thì code như sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
 
End Sub

Cái này cũng còn sửa code nữa anh, lỡ tên sheet cần copy không phải là "Sheet1",

 

[Hai Lúa Miền Tây]

Cái này cũng còn sửa code nữa anh, lỡ tên sheet cần copy không phải là "Sheet1",

Dĩ nhiên rồi Thảo, đó chỉ là ví dụ, vì mình không rõ ý tác giả muốn như thế nào.

 

[Minh Đức 1309]

Code như trên thôi bạn. Ví dụ tôi lưu sheet với tên là Sheet1 thành file mới chung với thư mục file hiện hành, tên file là cell A1 trong sheet1 thì code như sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
 
End Sub

Cảm ơn thầy ạ chúc thầy mạnh khỏe!!!!

 

[Minh Đức 1309]

Code như trên thôi bạn. Ví dụ tôi lưu sheet với tên là Sheet1 thành file mới chung với thư mục file hiện hành, tên file là cell A1 trong sheet1 thì code như sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
 
End Sub

Thầy ơi nếu muốn lưu vào thư mục chỉ định ví dụ :C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU thì phải sửa code ntn vậy ạ

 

[Hai Lúa Miền Tây]

Thầy ơi nếu muốn lưu vào thư mục chỉ định ví dụ :C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU thì phải sửa code ntn vậy ạ

Thì bạn thay thế cái Thisworkbook.path thành đường dẫn là được nhé.

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
 
End Sub

 

[Minh Đức 1309]

Cảm ơn mọi người nhiều ạ code của mọi người đều dùng rất tốt