Chuyển 1 sheet thành 1 file (1 người xem)

[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.

 

[MinhCong]

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.

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

 

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

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.

Bạn dùng code sau nhé:

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        Application.Workbooks(Application.Workbooks.Count).Close _
                    True, strPath & "\ Ten Sheet " & sh.Name
     Next
  Application.ScreenUpdating = True
  
  End Sub

P/S: Nó sẽ lưu vào chung với thư mục của file gốc nhé.

 

[Vinix]

Tình hình là sau khi thêm đoạn code này vào. Cứ mở excel là nó tạo 1 file mới có tên là tên sheet sheet 1. :-??. Xóa hết macro cũng không được. (

 

[Vinix]

Không biết xử lý vụ này thế nào. Giống bị dính virus quá. huhu

 

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

Không biết xử lý vụ này thế nào. Giống bị dính virus quá. huhu

Bạn chép code vào đâu, Bạn gửi file xem thử nhé

 

[Tran Mui]

Theo tôi Bạn nên dùng cách của MinhCong là tốt nhất
Tôi đã dùng như thế nhiều rồi
Chúc thành công (mở sheet cần chuyển sang file-chuột phải-chọn Move or copy- .......)

 

[phuyen89]

Bạn nhấn Alt+F4 rồi paste Code của Dom và.Bạn quay ra Excel chọn thanh công cụ của Form, vẽ nó một đường và chọn Luu File nhấn một phát vào nút lệnh đó là nó cho nhiều Sheet chung trong một Folder.Cái này mà khi xuất sang 1 File mà cho các số liệu còn y nguyên thì quý biết mấy.Nhưng ô có công thức đều bị lỗi #REF hết.Buồn ghê.

 

[khaothibaclieu]

Bạn dùng code sau nhé:

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        Application.Workbooks(Application.Workbooks.Count).Close _
                    True, strPath & "\ Ten Sheet " & sh.Name
     Next
  Application.ScreenUpdating = True
  
  End Sub

P/S: Nó sẽ lưu vào chung với thư mục của file gốc nhé.

Code này thì chuyển từng sheet thành từng file (workbook có bao nhiêu sheet thì thành bấy nhiêu file). Nhưng nếu chỉ muốn chuyển duy nhất 1 sheet cụ thể (ví dụ Sheet 1) thành 1 file thì phải sửa như thế nào? Cám ơn các anh chị.

 

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

Code này thì chuyển từng sheet thành từng file (workbook có bao nhiêu sheet thì thành bấy nhiêu file). Nhưng nếu chỉ muốn chuyển duy nhất 1 sheet cụ thể (ví dụ Sheet 1) thành 1 file thì phải sửa như thế nào? Cám ơn các anh chị.

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

 

[MinhKhai]

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

Code của tác giả rất gọn và đã đáp ứng yêu cầu của chủ topic. Em xin hỏi thêm mấy câu hỏi nâng cao để học hỏi
Code trên tạo file có tên mặc định là sheet1. Xin tác giả bổ sung cách để:
+ Tên file thêm ngày tháng hiện hành (VD: BC_15.06.xls)
+ Nếu sử dụng Code 2 lần sheet sau tự động đè (overwrite)sheet trước. Cần có cảnh báo hoặc tự động thêm ký tự phụ vào tên file mới sinh
+ Code để đổi tên sheet khi sheet được chuyển sang file? mới ?

 

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

Code của tác giả rất gọn và đã đáp ứng yêu cầu của chủ topic. Em xin hỏi thêm mấy câu hỏi nâng cao để học hỏi
Code trên tạo file có tên mặc định là sheet1. Xin tác giả bổ sung cách để:
+ Tên file thêm ngày tháng hiện hành (VD: BC_15.06.xls)
+ Nếu sử dụng Code 2 lần sheet sau tự động đè (overwrite)sheet trước. Cần có cảnh báo hoặc tự động thêm ký tự phụ vào tên file mới sinh
+ Code để đổi tên sheet khi sheet được chuyển sang file? mới ?

Dùng code sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
End Sub

 

[nhk007dn]

Dùng code sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
End Sub

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!

 

[chuot0106]

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!

Bạn đưa File giả lập lên đây.

 

[nhk007dn]

Bạn đưa File giả lập lên đây.

Mình gửi file đính kèm

 

[chuot0106]

Mình gửi file đính kèm

Thay vì hiện bảng chọn đường dẫn tôi sẽ lưu luôn sheet hiện hành thành 1 File vào đường dẫn chỉ định có được không?

 

[nhk007dn]

Thay vì hiện bảng chọn đường dẫn tôi sẽ lưu luôn sheet hiện hành thành 1 File vào đường dẫn chỉ định có được không?

Không thể chọn đường dẫn vậy nhờ bạn giúp tạo 1 folder cùng đường dẫn với file chính và lấy tên folder là tên file chính (file gốc chứa nhiều sheet) sau đó lưu sheet trong folder đó.
Đối với các sheet lưu sau mà cùng nằm trong file excel chính, nếu kiểm tra có folder rồi thì ko cần tạo folder nữa mà lưu thẳng vào folder đó luôn.
Còn tên file có thay đổi được không vậy bạn?
Không biết mình yêu cầu vậy có khó quá không, mong các bạn thông cảm!
Mình cảm ơn nhiều!

 

[chuot0106]

Còn tên file có thay đổi được không vậy bạn?
Mình cảm ơn nhiều!

Muốn thay đổi thì bạn cứ thay đổi thôi! Không ản h hưởng gì cả?

 

[nhk007dn]

Muốn thay đổi thì bạn cứ thay đổi thôi! Không ản h hưởng gì cả?

Mình cảm ơn bạn trước!

 

[chuot0106]

Không thể chọn đường dẫn vậy nhờ bạn giúp tạo 1 folder cùng đường dẫn với file chính và lấy tên folder là tên file chính (file gốc chứa nhiều sheet) sau đó lưu sheet trong folder đó.
Đối với các sheet lưu sau mà cùng nằm trong file excel chính, nếu kiểm tra có folder rồi thì ko cần tạo folder nữa mà lưu thẳng vào folder đó luôn.
Còn tên file có thay đổi được không vậy bạn?
Không biết mình yêu cầu vậy có khó quá không, mong các bạn thông cảm!
Mình cảm ơn nhiều!

Của bạn đây:
+ Cách dùng: Tại sheet hiện hành bạn bấm tổ hợp phím Ctrl+Shift+A để chạy code lưu Sheet hiện hành. Tôi tạo thư mục có tên là "CT" trong ổ D("D:\CT") các sheet hiện hành được lưu vào Folder này với tên File chính là tên của các Sheet đó!

 

[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

 

[Minh Đức 1309]

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

Thầy ơi cho con hỏi thêm là cái sheet mình tach ra là 1 vùng dữ liệu mình muốn khi tách thành file mới n đặt name cho vùng dữ liệu ở file mới luôn thì sao ạ

 

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

Thầy ơi cho con hỏi thêm là cái sheet mình tach ra là 1 vùng dữ liệu mình muốn khi tách thành file mới n đặt name cho vùng dữ liệu ở file mới luôn thì sao ạ

Đặt name cho vùng thì gán như sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10" ' Vung A1:C10 cua sheet1'
         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]

Đặt name cho vùng thì gán như sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10" ' Vung A1:C10 cua sheet1'
         ActiveWorkbook.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Code này thì tách sheet thành file nhưng vẫn giữ nguyên sheet ở file gốc,con muốn tách xong xóa sheet ở file gốc thì sao ạ.

 

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

Code này thì tách sheet thành file nhưng vẫn giữ nguyên sheet ở file gốc,con muốn tách xong xóa sheet ở file gốc thì sao ạ.

Bạn xóa bình thường thôi nhé. Tuy nhiên khi xóa sheet đó rồi thì code sau này tìm sheet đó ở đâu để copy tiếp?

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"
         ActiveWorkbook.Close True, "D:\" & Sheets("Sheet1").Range("A1")
         If Worksheets.Count > 1 Then
            Sheets("Sheet1").Delete
         Else
            MsgBox "Khong the xoa sheet khi file chi co 1 sheet"
            
         End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

 

[Minh Đức 1309]

Bạn xóa bình thường thôi nhé. Tuy nhiên khi xóa sheet đó rồi thì code sau này tìm sheet đó ở đâu để copy tiếp?

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"
         ActiveWorkbook.Close True, "D:\" & Sheets("Sheet1").Range("A1")
         If Worksheets.Count > 1 Then
            Sheets("Sheet1").Delete
         Else
            MsgBox "Khong the xoa sheet khi file chi co 1 sheet"
           
         End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Thầy ơi có hàm nào đổi từ ngày âm sang ngày dương k ạ

 

[Minh Đức 1309]

Thầy ơi có hàm nào đổi từ ngày âm sang ngày dương k ạ

Dạ con muốn dùng câu lệnh
Sub copysheets()
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "KHO"
Sheets("Sheet3").Select
Selection.Copy
Sheets("KHO").Select
Range("B6").Select
ActiveSheet.Paste
End Sub
để copy sang sheet mới đổi tên là kho rồi sẽ tách ạ.Nhưng khúc mắc ở chỗ cứ thêm sheet mới thì tên sheet sẽ tăng là sheet 4 chứ k còn là sheet 3 nữa lên code k chạy Thầy khắc phục giúp con với ạ.Tại con chỉ muốn copy 1 vùng giữ liệu trong sheet thành file mới với dữ liệu ở đó được paste value chứ k còn có công thức ạ

 

[Minh Đức 1309]

Thầy ơi có hàm nào đổi từ ngày âm sang ngày dương k ạ

Hoặc là copy cả sheet nhưng con muốn paste value thôi k có công thức trong file copy thì làm ntn thầy ơi

 

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

Dạ con muốn dùng câu lệnh
Sub copysheets()
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "KHO"
Sheets("Sheet3").Select
Selection.Copy
Sheets("KHO").Select
Range("B6").Select
ActiveSheet.Paste
End Sub
để copy sang sheet mới đổi tên là kho rồi sẽ tách ạ.Nhưng khúc mắc ở chỗ cứ thêm sheet mới thì tên sheet sẽ tăng là sheet 4 chứ k còn là sheet 3 nữa lên code k chạy Thầy khắc phục giúp con với ạ.Tại con chỉ muốn copy 1 vùng giữ liệu trong sheet thành file mới với dữ liệu ở đó được paste value chứ k còn có công thức ạ

Vậy thì cứ việc copy thôi bạn, đâu cần phải thêm sheet mới rồi copy, sau khi copy thì xóa sheet mới đó. Như vậy nó lòng vòng.
Chỉ việc copy vùng của sheet1 sang file mới rồi lưu file đó lại thôi. Vùng cần copy và đường dẫn thì bạn tự điều chỉnh theo ý nhé.

Sub LuuFile_1()
    Dim newWB As Workbook
    Set newWB = Workbooks.Add
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        ThisWorkbook.Sheets("Sheet1").Range("A1:C10").Copy
        newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
        newWB.Close True, "D:\" & ThisWorkbook.Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

 

[Minh Đức 1309]

Vậy thì cứ việc copy thôi bạn, đâu cần phải thêm sheet mới rồi copy, sau khi copy thì xóa sheet mới đó. Như vậy nó lòng vòng.
Chỉ việc copy vùng của sheet1 sang file mới rồi lưu file đó lại thôi. Vùng cần copy và đường dẫn thì bạn tự điều chỉnh theo ý nhé.

Sub LuuFile_1()
    Dim newWB As Workbook
    Set newWB = Workbooks.Add
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        ThisWorkbook.Sheets("Sheet1").Range("A1:C10").Copy
        newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
        newWB.Close True, "D:\" & ThisWorkbook.Sheets("Sheet1").Range("A1")
        .DisplayAlerts = True
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Sub Luufile()
Dim newWB As Workbook
Set newWB = Workbooks.Add
Sheet2.Activate
Names.Add Name:="KHO", RefersTo:=Range("A1", Range("G1").End(xlDown).Offset(2, 0))

With Application
.ScreenUpdating = False
.DisplayAlerts = False
ThisWorkbook.Sheet2.Range("A8").CurrentRegion.Copy
newWB.Sheets("Sheet1").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
newWB.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheet2.Range("K3")
.DisplayAlerts = True
.ScreenUpdating = True
End With


MsgBox "Luu file ngày : " & Sheet2.Range("k3") & " thành công"

End Sub
THẦY XEM GIÚP CON CODE SAI Ở ĐÂU VỚI Ạ.Tại con muốn paste value giữ định dạng đấy ạ

 

[Minh Đức 1309]

ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"

ctiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10

Bạn xóa bình thường thôi nhé. Tuy nhiên khi xóa sheet đó rồi thì code sau này tìm sheet đó ở đâu để copy tiếp?

Sub LuuFile()
   With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         Sheets("Sheet1").Copy
         ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"
         ActiveWorkbook.Close True, "D:\" & Sheets("Sheet1").Range("A1")
         If Worksheets.Count > 1 Then
            Sheets("Sheet1").Delete
         Else
            MsgBox "Khong the xoa sheet khi file chi co 1 sheet"
           
         End If
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Sub Luufile()
Dim newWB As Workbook
Set newWB = Workbooks.Add
Workbooks("NL&KT").Sheets("SO_CHITIET").Activate
Names.Add Name:="KHO", RefersTo:=Range("A2", Range("G2").End(xlDown).Offset(2, 0))

With Application
.ScreenUpdating = False
.DisplayAlerts = False
ThisWorkbook.Sheets("SO_CHITIET").Range("A8").CurrentRegion.Copy
newWB.Activate
newWB.Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
newWB.Names.Add Name:="KHO", RefersTo:=Range("A2").CurrentRegion
newWB.Close True, "C:\Users\Administrator\Desktop\VBA 2019\FILE DU LIEU\" & Sheet2.Range("K3")
.DisplayAlerts = True
.ScreenUpdating = True
End With


MsgBox "Luu file ngày : " & Sheet2.Range("k3") & " thành công"

End Sub
Con đã sửa code nhưng k paste được value giữ nguyên định dạng thầy giúp con với.Do k có điều kiện toàn tự học,phiền thầy nhiều

 

[Love GPE]

Dùng code sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   
End Sub

Cảm ơn Anh Hai Lúa Miền Tây, đã chia sẻ đoạn code rất hay. Em muốn bổ sung thêm vào 1 trường hợp là kết xuất sheet ra file mới thì file mới nó chuyển thành giá trị (không còn công thức bên trong). Do có khi sheet chỉ là số liệu tổng hợp từ các sheet khác vào. Nên nếu kết xuất mà không chuyển sang value thì sẽ bị lỗi. Mong Anh giúp Em thêm. Cảm ơn Anh nhiều!

 

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

Cảm ơn Anh Hai Lúa Miền Tây, đã chia sẻ đoạn code rất hay. Em muốn bổ sung thêm vào 1 trường hợp là kết xuất sheet ra file mới thì file mới nó chuyển thành giá trị (không còn công thức bên trong). Do có khi sheet chỉ là số liệu tổng hợp từ các sheet khác vào. Nên nếu kết xuất mà không chuyển sang value thì sẽ bị lỗi. Mong Anh giúp Em thêm. Cảm ơn Anh nhiều!

Bạn có thể chuyển nó thành value như sau nhé.

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         Cells.Copy
         Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
  
End Sub

 

[Love GPE]

Bạn có thể chuyển nó thành value như sau nhé.

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         Cells.Copy
         Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
 
End Sub

Bạn có thể chuyển nó thành value như sau nhé.

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         Cells.Copy
         Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
 
End Sub

Anh ơi Em chạy thử code thì nó đang chuyển thành Value ở sheet nguồn. Còn sheet ở file mới thì nó chưa chuyển được sang Value Anh ạ. Mong Anh xem giúp Em. Cảm ơn Anh nhiều!

 

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

Anh ơi Em chạy thử code thì nó đang chuyển thành Value ở sheet nguồn. Còn sheet ở file mới thì nó chưa chuyển được sang Value Anh ạ. Mong Anh xem giúp Em. Cảm ơn Anh nhiều!

Vậy bạn thử cho nó vào ActiveSheet xem sao nhé.

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         ActiveSheet.Cells.Copy
         ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With
 
End Sub

 

[Love GPE]

Vậy bạn thử cho nó vào ActiveSheet xem sao nhé.

Sub LuuFile()
   With Application
        .ScreenUpdating = False
         Sheets("sheet1").Copy
         ActiveSheet.Name = "TenSheetMoi"
         ActiveSheet.Cells.Copy
         ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
         ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
        .ScreenUpdating = True
    End With

End Sub

Dạ được rồi Anh ạ. Cảm ơn Anh nhiều!

 

[FAPV]

Dùng code sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   
End Sub

Code này rất hay , đã thực hiện thành công
còn một điểm nhờ giúp đỡ,
khi xuất ra cho thêm lệnh xóa đi công thức được không?, chỉ một vùng nào đó trong sheet

 

[Hoàng Tuấn 868]

Code này rất hay , đã thực hiện thành công
còn một điểm nhờ giúp đỡ,
khi xuất ra cho thêm lệnh xóa đi công thức được không?, chỉ một vùng nào đó trong sheet

Câu này cũng rất hay, nếu đoạn đầu thêm phần chào hỏi, đoạn cuối thêm câu cảm ơn nữa thì hoàn hảo.

 

[VetMini]

Câu này cũng rất hay, nếu đoạn đầu thêm phần chào hỏi, đoạn cuối thêm câu cảm ơn nữa thì hoàn hảo.

Hoàn hảo mốc xì.
"công thức" ở đâu ra mà xóa?

 

[Hoàng Tuấn 868]

Hoàn hảo mốc xì.
"công thức" ở đâu ra mà xóa?

Em chỉ lưu ý phần đầu và phần cuối thôi, đoạn giữa em bỏ qua rồi anh ơi.

 

[viho79]

Dùng code sau:

Sub LuuFile()
   With Application
        .ScreenUpdating = False
      '  .DisplayAlerts = False
            Sheets("sheet1").Copy
            ActiveSheet.Name = "TenSheetMoi"
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\BC_" & Format(Now(), "dd-mm")
       ' .DisplayAlerts = True
        .ScreenUpdating = True
    End With
   
End Sub

Mình nhờ các cao thủ chỉ giúp: Mình có 1 file có nhiều sheet. trong mỗi sheet lại có công thức và đã định vùng cần in (tức là đã Set printer area. Mình cần tạo một đoạn code gắn với 1 nút sao cho: Nhấn nút lần 1 nó sẽ chuyển sheet hiện hành (chỉ lấy phần đã set printer area) thành 1 file mới có tên Phongthi và sheet đó có tên P1 (lưu ý: chỉ lấy giá trị chứ không lấy công thức, giữ nguyên Form). Khi nhấn nút lần 2 thì tương tự sẽ tạo thêm 1 sheet thứ 2 có tên P2 cùng trên file Phongthi đã tạo ở lần nhấn nút 1, nhấn nút lần 3, 4, 5,.... tương tự thành P3, P4, .....

Xin cảm ơn rất nhiều

 

[LePhatHuy]

Mình nhờ các cao thủ chỉ giúp: Mình có 1 file có nhiều sheet. trong mỗi sheet lại có công thức và đã định vùng cần in (tức là đã Set printer area. Mình cần tạo một đoạn code gắn với 1 nút sao cho: Nhấn nút lần 1 nó sẽ chuyển sheet hiện hành (chỉ lấy phần đã set printer area) thành 1 file mới có tên Phongthi và sheet đó có tên P1 (lưu ý: chỉ lấy giá trị chứ không lấy công thức, giữ nguyên Form). Khi nhấn nút lần 2 thì tương tự sẽ tạo thêm 1 sheet thứ 2 có tên P2 cùng trên file Phongthi đã tạo ở lần nhấn nút 1, nhấn nút lần 3, 4, 5,.... tương tự thành P3, P4, .....

Xin cảm ơn rất nhiều

Thử rồi cho mình biết kết quả nhen.

Sub TaoFileMoi()
    Dim ws As Worksheet
    Dim newWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim filePath As String
    Dim sheetName As String
    Dim sheetCounter As Integer
   
    ' Đường dẫn để lưu file mới
    filePath = ThisWorkbook.Path & "\Phongthi.xlsx"
   
    ' Kiểm tra xem file đã tồn tại hay chưa
    If Dir(filePath) = "" Then
        ' Nếu chưa tồn tại, tạo file mới
        Set newWorkbook = Workbooks.Add
        newWorkbook.SaveAs Filename:=filePath
        newWorkbook.Close SaveChanges:=True
    End If
   
    ' Mở file đã tồn tại hoặc vừa được tạo
    Workbooks.Open Filename:=filePath
    Set newWorkbook = Workbooks("Phongthi.xlsx")
   
    ' Đếm số sheet hiện có trong file Phongthi để đặt tên cho sheet mới
    sheetCounter = newWorkbook.Sheets.Count + 1
   
    ' Tạo tên sheet mới
    sheetName = "P" & sheetCounter
   
    ' Copy vùng đã set print area từ sheet hiện hành sang file mới
    Set ws = ThisWorkbook.ActiveSheet
    Set newSheet = newWorkbook.Sheets.Add(After:=newWorkbook.Sheets(newWorkbook.Sheets.Count))
    newSheet.Name = sheetName
   
    ws.Range(ws.PageSetup.PrintArea).Copy
    newSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
    newSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
   
    ' Lưu và đóng file
     newWorkbook.Close SaveChanges:=True
End Sub

 

[viho79]

Thử rồi cho mình biết kết quả nhen.

Sub TaoFileMoi()
    Dim ws As Worksheet
    Dim newWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim filePath As String
    Dim sheetName As String
    Dim sheetCounter As Integer
 
    ' Đường dẫn để lưu file mới
    filePath = ThisWorkbook.Path & "\Phongthi.xlsx"
 
    ' Kiểm tra xem file đã tồn tại hay chưa
    If Dir(filePath) = "" Then
        ' Nếu chưa tồn tại, tạo file mới
        Set newWorkbook = Workbooks.Add
        newWorkbook.SaveAs Filename:=filePath
        newWorkbook.Close SaveChanges:=True
    End If
 
    ' Mở file đã tồn tại hoặc vừa được tạo
    Workbooks.Open Filename:=filePath
    Set newWorkbook = Workbooks("Phongthi.xlsx")
 
    ' Đếm số sheet hiện có trong file Phongthi để đặt tên cho sheet mới
    sheetCounter = newWorkbook.Sheets.Count + 1
 
    ' Tạo tên sheet mới
    sheetName = "P" & sheetCounter
 
    ' Copy vùng đã set print area từ sheet hiện hành sang file mới
    Set ws = ThisWorkbook.ActiveSheet
    Set newSheet = newWorkbook.Sheets.Add(After:=newWorkbook.Sheets(newWorkbook.Sheets.Count))
    newSheet.Name = sheetName
 
    ws.Range(ws.PageSetup.PrintArea).Copy
    newSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
    newSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
 
    ' Lưu và đóng file
     newWorkbook.Close SaveChanges:=True
End Sub

Nó chỉ tạo ra được một file có tên là Phongthi, trong file đó chỉ có 2 sheet có tên: sheet1 và P2. Các sheet này đều trống rỗng. Khi chạy lần 2 thì nó hỏi có thay thế file đã tạo ở lần 1 hay không? Nếu chọn OK thì nó thay luôn và ile tạo ra vẫn là Phongthi và vẫn có 2 sheet: Sheet1 và P2, Các sheet này vẫn trống rỗng như lần 1. Bạn có thể giúp mình xem lại được không?

 

[LePhatHuy]

Nó chỉ tạo ra được một file có tên là Phongthi, trong file đó chỉ có 2 sheet có tên: sheet1 và P2. Các sheet này đều trống rỗng. Khi chạy lần 2 thì nó hỏi có thay thế file đã tạo ở lần 1 hay không? Nếu chọn OK thì nó thay luôn và ile tạo ra vẫn là Phongthi và vẫn có 2 sheet: Sheet1 và P2, Các sheet này vẫn trống rỗng như lần 1. Bạn có thể giúp mình xem lại được không?

Bạn nên đọc kỹ yêu cầu bài #60 nhen.