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

Vinix · 27/4/10

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 · 27/4/10

Vinix đã viết:
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 · 27/4/10

Vinix đã viết:
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.

Bạn dùng code sau nhé:

Mã:

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: Nó sẽ lưu vào chung với thư mục của file gốc nhé.

Vinix · 30/4/10

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 · 30/4/10

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 · 30/4/10

Vinix đã viết:
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 · 30/4/10

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 · 30/4/10

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 · 13/6/13

Hai Lúa Miền Tây đã viết:
Bạn dùng code sau nhé:

Mã:

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: Nó sẽ lưu vào chung với thư mục của file gốc nhé.

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 · 14/6/13

khaothibaclieu đã viết:
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:

Mã:

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 · 15/6/13

Hai Lúa Miền Tây đã viết:
Bỏ vòng lặp đi là được:

Mã:

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 · 15/6/13

MinhKhai đã viết:
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:

Mã:

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 · 23/5/15

Hai Lúa Miền Tây đã viết:

Dùng code sau:

Mã:

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 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

chuot0106 đã viết:
Bạn đưa File giả lập lên đây.

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

chuot0106 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

chuot0106 đã viết:
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 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

chuot0106 đã viết:
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 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

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

nhk007dn · 23/5/15

Mã:

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 · 23/5/15

nhk007dn đã viết:

Mã:

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 · 23/5/15

chuot0106 đã viết:
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 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

ndu96081631 đã viết:
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 · 23/5/15

nhk007dn đã viết:
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 · 23/5/15

nhk007dn đã viết:
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 · 30/1/19

MinhCong đã viết:
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 · 2/6/19

Hai Lúa Miền Tây đã viết:
Bỏ vòng lặp đi là được:

Mã:

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 · 3/6/19

Minh Đức 1309 đã viết:
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 · 3/6/19

Hai Lúa Miền Tây đã viết:
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 · 3/6/19

Minh Đức 1309 đã viết:
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:

Mã:

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 · 3/6/19

Hai Lúa Miền Tây đã viết:
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:

Mã:

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 · 3/6/19

leonguyenz đã viết:
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 · 3/6/19

Hai Lúa Miền Tây đã viết:
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:

Mã:

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 · 3/6/19

Hai Lúa Miền Tây đã viết:
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:

Mã:

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 · 4/6/19

Minh Đức 1309 đã viết:
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é.

Mã:

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 · 5/6/19

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 · 7/6/19

Hai Lúa Miền Tây đã viết:
Thì bạn thay thế cái Thisworkbook.path thành đường dẫn là được nhé.

Mã:

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 · 7/6/19

Minh Đức 1309 đã viết:
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:

Mã:

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 · 7/6/19

Hai Lúa Miền Tây đã viết:

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

Mã:

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 · 7/6/19

Minh Đức 1309 đã viết:
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?

Mã:

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 · 7/6/19

Hai Lúa Miền Tây đã viết:

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?

Mã:

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 · 7/6/19

Minh Đức 1309 đã viết:
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 · 7/6/19

Minh Đức 1309 đã viết:
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 · 8/6/19

Minh Đức 1309 đã viết:
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é.

Mã:

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 · 8/6/19

Hai Lúa Miền Tây đã viết:
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é.

Mã:

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 · 8/6/19

Hai Lúa Miền Tây đã viết:
ActiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10"

Hai Lúa Miền Tây đã viết:
ctiveWorkbook.Names.Add Name:="Name", RefersTo:="=Sheet1!$A$1:$C$10

Hai Lúa Miền Tây đã viết:

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?

Mã:

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 · 1/12/20

Hai Lúa Miền Tây đã viết:

Dùng code sau:

Mã:

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 · 2/12/20

Love GPE đã viết:
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é.

Mã:

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 · 2/12/20

Hai Lúa Miền Tây đã viết:

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

Mã:

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

Hai Lúa Miền Tây đã viết:

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

Mã:

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 · 2/12/20

Love GPE đã viết:
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é.

Rich (BB code):

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 · 2/12/20

Hai Lúa Miền Tây đã viết:

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

Rich (BB code):

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 · 20/11/23

Hai Lúa Miền Tây đã viết:

Dùng code sau:

Mã:

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 · 20/11/23

FAPV đã viết:
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 · 20/11/23

Hoàng Tuấn 868 đã viết:
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 · 20/11/23

VetMini đã viết:
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 · 28/5/25

Hai Lúa Miền Tây đã viết:

Dùng code sau:

Mã:

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 · 29/5/25

viho79 đã viết:
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.

Mã:

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 · 29/5/25

LePhatHuy đã viết:

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

Mã:

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 · 30/5/25

viho79 đã viết:
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.

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

Người dùng đang xem chủ đề này

Thành viên mới

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên mới

Thành viên mới

❆❆❆❆❆❆❆❆

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

Thành viên tích cực

Thành viên hoạt động

❆❆❆❆❆❆❆❆

Giải pháp Ếc-xào

❆❆❆❆❆❆❆❆

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

File đính kèm

Thành viên gắn bó

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

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

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

Thành viên gắn bó

Huyền thoại GPE

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

Thành viên gắn bó

Huyền thoại GPE

Thành viên mới

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

❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆

Thành viên gạo cội

❆❆❆❆❆❆❆❆

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

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

❆❆❆❆❆❆❆❆

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

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

❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆

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

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

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

❆❆❆❆❆❆❆❆

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

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

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

❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆

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

Thành viên mới

Đăng ký hôm qua

Đang đi tìm hòn đá

Đăng ký hôm qua

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

Thời gian đếm ngược.