Tạo workbook mới khi chọn danh sách từ combox box

[Sheva87]

Kính gởi các Anh/Chị,

Em có 01 workbook "Test Code", trong đó có " Sheet 1" chứa 01 Combo box dạng Form Control. Khi chọn mỗi giá trị trong combo box thì file excel sẽ tính toán (theo công thức đã cài sẵn).
Em muốn tạo 01 code VBA để thực hiện chọn từng giá trị trong combo box, sau đó sẽ copy toàn bộ dữ liệu của "sheet 1" paste (value và giữ nguyên định dạng) sang 1 workbook mới, ứng với mỗi giá trị trong Combo box là 01 sheet tương ứng, với tên sheet mới là giá trị đã chọn của Combo box
rất mong nhận được hỗ trợ của các Anh/Chị
Trân trọng

 

[BuiQuangThuan]

Kính gởi các Anh/Chị,

Em có 01 workbook "Test Code", trong đó có " Sheet 1" chứa 01 Combo box dạng Form Control. Khi chọn mỗi giá trị trong combo box thì file excel sẽ tính toán (theo công thức đã cài sẵn).
Em muốn tạo 01 code VBA để thực hiện chọn từng giá trị trong combo box, sau đó sẽ copy toàn bộ dữ liệu của "sheet 1" paste (value và giữ nguyên định dạng) sang 1 workbook mới, ứng với mỗi giá trị trong Combo box là 01 sheet tương ứng, với tên sheet mới là giá trị đã chọn của Combo box
rất mong nhận được hỗ trợ của các Anh/Chị
Trân trọng

Thử kiểm tra xem đúng ý bạn không?

 

[Sheva87]

em cám ơn. nhưng vẫn chưa hoàn thiện ạ.
1. ý em là code sẽ "tự động" chọn lần lượt các giá trị trong combo box, ứng với mỗi giá trị đó sẽ tạo ra 01 sheet mới (trong cùng 1 workbook mới)
2. Sheet đích chỉ lấy giá trị và định dạng.
Trân trọng

 

[BuiQuangThuan]

em cám ơn. nhưng vẫn chưa hoàn thiện ạ.
1. ý em là code sẽ "tự động" chọn lần lượt các giá trị trong combo box, ứng với mỗi giá trị đó sẽ tạo ra 01 sheet mới (trong cùng 1 workbook mới)
2. Sheet đích chỉ lấy giá trị và định dạng.
Trân trọng

Bạn nhờ cả thế thì chờ thành viên khác giúp cùng với. Tắt máy tính rồi. Nếu như bạn nói thì không cần cái combobox đó. Duyệt qua cái list ở sheet2 là được

 

[Hoàng Tuấn 868]

em cám ơn. nhưng vẫn chưa hoàn thiện ạ.
1. ý em là code sẽ "tự động" chọn lần lượt các giá trị trong combo box, ứng với mỗi giá trị đó sẽ tạo ra 01 sheet mới (trong cùng 1 workbook mới)
2. Sheet đích chỉ lấy giá trị và định dạng.
Trân trọng

Bạn không nên nói là người giúp bạn chưa hoàn thiện. Đây là do bạn diễn giải chưa rõ ý nên người giúp làm vậy là phải rồi. Nếu mình có làm cũng chỉ làm như vậy thôi.

 

[BuiQuangThuan]

Bạn không nên nói là người giúp bạn chưa hoàn thiện. Đây là do bạn diễn giải chưa rõ ý nên người giúp làm vậy là phải rồi. Nếu mình có làm cũng chỉ làm như vậy thôi.

Đọc dỗi hẳn luôn ấy. Anh chấm cho người ta cái kìa

 

[Sheva87]

Vâng xin lỗi anh BuiQuangThuận, cám ơn các Anh Hoàng Tuấn đã góp ý ạ.

 

[Hoàng Tuấn 868]

Vâng xin lỗi anh BuiQuangThuận, cám ơn các Anh Hoàng Tuấn đã góp ý ạ.

Bạn nên đưa file kết quả mong muốn (tạm làm thủ công) lên, ai đó muốn giúp sẽ dễ hình dung hơn là tả một hồi nhưng người đọc vẫn không hiểu đúng ý người nhờ giúp được.

 

[Sheva87]

Em gởi lại file Kế quả và file dữ liệu gốc ạ.

 

[BuiQuangThuan]

Em gởi lại file Kế quả và file dữ liệu gốc ạ.

Thử code này. Tạo 1 cái nút rồi gán nó vào. File cuối cùng được tạo ra cùng đường dẫn với file mẹ tên là ketqua

Sub ABC()
    Dim File_Name$
    Dim Rng As Range, Wb As Workbook
    Dim newWorkbook As Workbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook
    Set newWorkbook = Workbooks.Add
    For Each Rng In Wb.Sheets("Sheet2").Range("A3:A6")
        k = k + 1
        Wb.Sheets("Sheet2").Range("B1").Value = k
        File_Name = Wb.Sheets("Sheet2").Range("C1").Value
        If File_Name = "*" Then File_Name = "Toan Nganh"
        Wb.Worksheets("Sheet1").Copy Before:=newWorkbook.Sheets(1)
        newWorkbook.Sheets(1).Name = File_Name
        newWorkbook.ActiveSheet.DrawingObjects.Delete
        newWorkbook.ActiveSheet.Range("A1:N7").Value = newWorkbook.ActiveSheet.Range("A1:N7").Value
    Next
    newWorkbook.Sheets("Sheet1").Delete
    newWorkbook.Close True, Wb.Path & "\" & "ketqua.xlsx", 51
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Hoàn thành"
End Sub

 

[Sheva87]

Vâng, em cám ơn Anh BuiQuangThuan rất nhiều.

 

[Hoàng Tuấn 868]

Thử code này. Tạo 1 cái nút rồi gán nó vào. File cuối cùng được tạo ra cùng đường dẫn với file mẹ tên là ketqua

Sub ABC()
    Dim File_Name$
    Dim Rng As Range, Wb As Workbook
    Dim newWorkbook As Workbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set Wb = ThisWorkbook
    Set newWorkbook = Workbooks.Add
    For Each Rng In Wb.Sheets("Sheet2").Range("A3:A6")
        k = k + 1
        Wb.Sheets("Sheet2").Range("B1").Value = k
        File_Name = Wb.Sheets("Sheet2").Range("C1").Value
        If File_Name = "*" Then File_Name = "Toan Nganh"
        Wb.Worksheets("Sheet1").Copy Before:=newWorkbook.Sheets(1)
        newWorkbook.Sheets(1).Name = File_Name
        newWorkbook.ActiveSheet.DrawingObjects.Delete
        newWorkbook.ActiveSheet.Range("A1:N7").Value = newWorkbook.ActiveSheet.Range("A1:N7").Value
    Next
    newWorkbook.Sheets("Sheet1").Delete
    newWorkbook.Close True, Wb.Path & "\" & "ketqua.xlsx", 51
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Hoàn thành"
End Sub

Hình như chưa khai báo biến k thì phải.

 

[BuiQuangThuan]

Hình như chưa khai báo biến k thì phải.

Không gán cái này nên khả năng vẫn chạy được anh ạ

Option Explicit

 

[Hoàng Tuấn 868]

Không gán cái này nên khả năng vẫn chạy được anh ạ

Option Explicit

Nhưng nên gán và khai báo vẫn hơn nhỉ.

 

[Sheva87]

Anh có thể điều chỉnh giúp em vùng rộng hơn được không ạ. em muốn lấy toàn bộ sheet 1 chuyển qua, giữ nguyên định dạng ban đầu (thực tế file của em có rất nhiều dòng, Group, định dạng các kiểu...) và chỉ lấy giá trị.

Em cám ơn.

 

[BuiQuangThuan]

Nhưng nên gán và khai báo vẫn hơn nhỉ.

Làm vội anh ạ. Anh cũng ngủ muộn nhỉ

 

[Hoàng Tuấn 868]

Làm vội anh ạ.

Không nên vội làm gì, còn một mớ phát sinh do không nêu dữ liệu đầy đủ ngay từ đầu kia kìa bạn ơi. Vụ này không lo thất nghiệp nhé.

 

[BuiQuangThuan]

Không nên vội làm gì, còn một mớ phát sinh do không nêu dữ liệu đầy đủ ngay từ đầu kia kìa bạn ơi.

Hihi. đang thấy thế nè. Chắc không theo thớt được rồi

 

[Hoàng Tuấn 868]

Hihi. đang thấy thế nè. Chắc không theo thớt được rồi

Củ cà rốt vẫn đang ở trước mặt đó mà.

 

[Sheva87]

Chào Anh BuiQuangThuan. Anh có thể điều chỉnh giúp em vùng rộng hơn được không ạ. em muốn lấy toàn bộ sheet 1 chuyển qua, giữ nguyên định dạng ban đầu (thực tế file của em có rất nhiều dòng, Group, định dạng các kiểu...) và chỉ lấy giá trị.

Em cám ơn.