Nhờ giúp đỡ Code - Tạo Sheet mới từ 1 Sheet mẫu

[ntngoc123]

Chào các anh/chị/cô/chú,

Em muốn tạo 1 nút lệnh để tự động thêm Sheet mới theo form 1 Sheet mẫu (cả định dạng và lệnh trong Sheet này) sau khi đã nhập thông tin nhân viên mới vào, tên của Sheet mới được tạo ra sẽ giống tên của nhân viên đó luôn ạ. Mọi người xem file Excel em đính kèm sẽ dễ hiểu hơn ạ.
Em có tự tìm hiểu và copy được 1 đoạn code nhưng nó không ra kết quả đúng.

Xin được cao nhân giúp đỡ ạ! Em xin cảm ơn.

 

[nghiaphuc]

Chào các anh/chị/cô/chú,

Em muốn tạo 1 nút lệnh để tự động thêm Sheet mới theo form 1 Sheet mẫu (cả định dạng và lệnh trong Sheet này) sau khi đã nhập thông tin nhân viên mới vào, tên của Sheet mới được tạo ra sẽ giống tên của nhân viên đó luôn ạ. Mọi người xem file Excel em đính kèm sẽ dễ hiểu hơn ạ.
Em có tự tìm hiểu và copy được 1 đoạn code nhưng nó không ra kết quả đúng.

Xin được cao nhân giúp đỡ ạ! Em xin cảm ơn.

Tôi thấy trong Module1 có code này rồi mà, bạn đổi tên sub cho hợp lệ và sửa câu lệnh:

.Sheets("Mau (2)").Name = ArrSheetName.Value

thành câu lệnh sau là được:

.Sheets("Mau (2)").Name = rng.Value

Cần thêm một đoạn code để kiểm tra sheet cần tạo đã tồn tại hay chưa nữa.
Ngoài ra, trên form cũng có 2 textbox có tên không hợp lệ nên code sẽ không chạy được đâu nhé.

 

[ntngoc123]

Tôi thấy trong Module1 có code này rồi mà, bạn đổi tên sub cho hợp lệ và sửa câu lệnh:

.Sheets("Mau (2)").Name = ArrSheetName.Value

thành câu lệnh sau là được:

.Sheets("Mau (2)").Name = rng.Value

Cần thêm một đoạn code để kiểm tra sheet cần tạo đã tồn tại hay chưa nữa.
Ngoài ra, trên form cũng có 2 textbox có tên không hợp lệ nên code sẽ không chạy được đâu nhé.

Em xin cám ơn ạ.
Em đã tạo được Sheet mới theo Sheet mẫu rồi nhưng tên Sheet mới vẫn chưa đúng như mong muốn (theo tên nhân viên).
Anh cho em hỏi 2 textbox không hợp lệ là cái nào ạ?
Và anh có thể giúp em đoạn code kiểm tra sheet cần tạo đã tồn tại chưa không ạ.

Em xin lỗi nhờ anh hơi nhiều vì em còn gà chỉ mới biết vba gần đây nên chưa biết viết code.
Cám ơn anh!

 

[Ba Tê]

Em xin cám ơn ạ.
Em đã tạo được Sheet mới theo Sheet mẫu rồi nhưng tên Sheet mới vẫn chưa đúng như mong muốn (theo tên nhân viên).
Anh cho em hỏi 2 textbox không hợp lệ là cái nào ạ?
Và anh có thể giúp em đoạn code kiểm tra sheet cần tạo đã tồn tại chưa không ạ.

Em xin lỗi nhờ anh hơi nhiều vì em còn gà chỉ mới biết vba gần đây nên chưa biết viết code.
Cám ơn anh!

Bạn xem file.

 

[ntngoc123]

Bạn xem file.

Thật rất cám ơn chú Ba Tê ạ. Con mò cả mấy ngày nay.
Chú có thể giúp con tạo thêm một đoạn code để khi bấm tạo sheet mới, tự động sẽ tạo luôn hyperlink trên tên nhân viên để dẫn tới sheet của người đó được không ạ?
Xin cảm ơn ạ.

 

[nghiaphuc]

Thật rất cám ơn chú Ba Tê ạ. Con mò cả mấy ngày nay.
Chú có thể giúp con tạo thêm một đoạn code để khi bấm tạo sheet mới, tự động sẽ tạo luôn hyperlink trên tên nhân viên để dẫn tới sheet của người đó được không ạ?
Xin cảm ơn ạ.

Bạn sửa lại code thế này:

Sub Insert_Sheet()
Dim ArrSheetName As Range, Rng As Range, EndR As Long
    EndR = Sheets("Danh Sach").Range("B1000").End(xlUp).Row
    Set ArrSheetName = Sheets("Danh Sach").Range("B4:B" & EndR)
For Each Rng In ArrSheetName
    If Rng <> "" Then
        If KiemTra(Rng.Value) = False Then
            Sheets("Mau").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Rng.Value
            Range("B3").Value = Rng.Value
            Rng.Hyperlinks.Add Rng, "", "'" & Rng.Value & "'!B3"
            Sheets(Rng.Value).Hyperlinks.Add Sheets(Rng.Value).Range("B3"), "", "'Danh sach'!" & Rng.Address
        End If
    End If
Next Rng
    Sheets("Danh Sach").Activate
    MsgBox ("ƒV[ƒg‚ð쬂µ‚Ü‚µ‚½B"), , "‚¨’m‚点!"
    Set ArrSheetName = Nothing
End Sub

 

[ndu96081631]

sau khi đã nhập thông tin nhân viên mới vào, tên của Sheet mới được tạo ra sẽ giống tên của nhân viên đó luôn ạ=

Liên quan đến TÊN thì bạn cần làm rõ chỗ này: Tên có thể trùng. Vậy nếu có trường hợp này xảy ra thì tên sheet sẽ là... cái gì?

 

[ntngoc123]

Bạn sửa lại code thế này:

Sub Insert_Sheet()
Dim ArrSheetName As Range, Rng As Range, EndR As Long
    EndR = Sheets("Danh Sach").Range("B1000").End(xlUp).Row
    Set ArrSheetName = Sheets("Danh Sach").Range("B4:B" & EndR)
For Each Rng In ArrSheetName
    If Rng <> "" Then
        If KiemTra(Rng.Value) = False Then
            Sheets("Mau").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Rng.Value
            Range("B3").Value = Rng.Value
            Rng.Hyperlinks.Add Rng, "", "'" & Rng.Value & "'!B3"
            Sheets(Rng.Value).Hyperlinks.Add Sheets(Rng.Value).Range("B3"), "", "'Danh sach'!" & Rng.Address
        End If
    End If
Next Rng
    Sheets("Danh Sach").Activate
    MsgBox ("ƒV[ƒg‚ð쬂µ‚Ü‚µ‚½B"), , "‚¨’m‚点!"
    Set ArrSheetName = Nothing
End Sub

Trúng phóc luôn rồi ạ. Cám ơn anh nhiều

Liên quan đến TÊN thì bạn cần làm rõ chỗ này: Tên có thể trùng. Vậy nếu có trường hợp này xảy ra thì tên sheet sẽ là... cái gì?

Nhờ anh nhắc nhở em đã khắc phục rồi ạ. Cám ơn anh!

 

[ntngoc123]

Chào anh nghiaphuc,
Vì em đã chỉnh lại tên sheet khi tạo mới (tên sheet mới kèm số thứ tự để phân biệt khi có trường hợp trùng tên), và kết quả là hyperlink nằm ở cột D như file đính kèm. Giờ em muốn chuyển hyperlink qua cột B (cột tên nhân viên) thì em sửa lại đoạn code này như thế nào ạ?
Em cảm ơn anh!
P/s: Em đã gộp 2 nút thành 1 nên code nằm ở Userform ạ.

Bạn sửa lại code thế này:

Sub Insert_Sheet()
Dim ArrSheetName As Range, Rng As Range, EndR As Long
    EndR = Sheets("Danh Sach").Range("B1000").End(xlUp).Row
    Set ArrSheetName = Sheets("Danh Sach").Range("B4:B" & EndR)
For Each Rng In ArrSheetName
    If Rng <> "" Then
        If KiemTra(Rng.Value) = False Then
            Sheets("Mau").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Rng.Value
            Range("B3").Value = Rng.Value
            Rng.Hyperlinks.Add Rng, "", "'" & Rng.Value & "'!B3"
            Sheets(Rng.Value).Hyperlinks.Add Sheets(Rng.Value).Range("B3"), "", "'Danh sach'!" & Rng.Address
        End If
    End If
Next Rng
    Sheets("Danh Sach").Activate
    MsgBox ("ƒV[ƒg‚ð쬂µ‚Ü‚µ‚½B"), , "‚¨’m‚点!"
    Set ArrSheetName = Nothing
End Sub

 

[nguyenthuy13388]

Bạn sửa lại code thế này:

Sub Insert_Sheet()
Dim ArrSheetName As Range, Rng As Range, EndR As Long
    EndR = Sheets("Danh Sach").Range("B1000").End(xlUp).Row
    Set ArrSheetName = Sheets("Danh Sach").Range("B4:B" & EndR)
For Each Rng In ArrSheetName
    If Rng <> "" Then
        If KiemTra(Rng.Value) = False Then
            Sheets("Mau").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Rng.Value
            Range("B3").Value = Rng.Value
            Rng.Hyperlinks.Add Rng, "", "'" & Rng.Value & "'!B3"
            Sheets(Rng.Value).Hyperlinks.Add Sheets(Rng.Value).Range("B3"), "", "'Danh sach'!" & Rng.Address
        End If
    End If
Next Rng
    Sheets("Danh Sach").Activate
    MsgBox ("ƒV[ƒg‚ð쬂µ‚Ü‚µ‚½B"), , "‚¨’m‚点!"
    Set ArrSheetName = Nothing
End Sub

hay quá cảm ơn bác nhiều, em phải dùng thêm vòng lặp nữa để tạo hyperlink

 

[nghiaphuc]

Chào anh nghiaphuc,
Vì em đã chỉnh lại tên sheet khi tạo mới (tên sheet mới kèm số thứ tự để phân biệt khi có trường hợp trùng tên), và kết quả là hyperlink nằm ở cột D như file đính kèm. Giờ em muốn chuyển hyperlink qua cột B (cột tên nhân viên) thì em sửa lại đoạn code này như thế nào ạ?
Em cảm ơn anh!
P/s: Em đã gộp 2 nút thành 1 nên code nằm ở Userform ạ.

Bạn sửa lại thế này:

Sub Insert_Sheet()
    Dim ArrSheetName As Range, Rng As Range, EndR As Long, SName As String
        EndR = Sheet1.Range("B1000").End(xlUp).Row
        Set ArrSheetName = Sheet1.Range("B4:B" & EndR)
    For Each Rng In ArrSheetName
        If Rng <> "" Then
            SName = Rng.Offset(, -1) & ". " & Rng.Value
            If KiemTra(SName) = False Then
                
                Sheet3.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = SName
                Rng.Hyperlinks.Add Rng, "", "'" & SName & "'!C3", "Toi sheet " & SName
                Sheets(SName).Hyperlinks.Add Sheets(SName).Range("C3"), "", "'" & Sheet1.Name & "'!" & Rng.Address, "Quay ve"
            End If
        End If
    Next Rng
        Sheet1.Activate
        MsgBox ("ƒV[ƒg‚ð쬂µ‚Ü‚µ‚½B"), , "‚¨’m‚点!"
        Set ArrSheetName = Nothing
End Sub

Lưu ý thêm: Trên các form có các đối tượng (Textbox, Combobox) được đặt tên không hợp lệ nên sẽ rắc rối khi viết và chạy code đấy. Tốt nhất tên của các đối tượng này nên được sử dụng tiếng Anh hoặc tiếng Việt không dấu, không nên dùng tiếng Nhật, tiếng Hàn hay tiếng Thái gì ráo, anh VBA không thích chơi với mấy anh này.

 

[ntngoc123]

Em cám ơn anh nhiều ạ. Em sẽ lưu ý vấn đề đặt tên, một lần nữa cám ơn anh.

Bạn sửa lại thế này:

Sub Insert_Sheet()
    Dim ArrSheetName As Range, Rng As Range, EndR As Long, SName As String
        EndR = Sheet1.Range("B1000").End(xlUp).Row
        Set ArrSheetName = Sheet1.Range("B4:B" & EndR)
    For Each Rng In ArrSheetName
        If Rng <> "" Then
            SName = Rng.Offset(, -1) & ". " & Rng.Value
            If KiemTra(SName) = False Then
               
                Sheet3.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = SName
                Rng.Hyperlinks.Add Rng, "", "'" & SName & "'!C3", "Toi sheet " & SName
                Sheets(SName).Hyperlinks.Add Sheets(SName).Range("C3"), "", "'" & Sheet1.Name & "'!" & Rng.Address, "Quay ve"
            End If
        End If
    Next Rng
        Sheet1.Activate
        MsgBox ("ƒV[ƒg‚ð쬂µ‚Ü‚µ‚½B"), , "‚¨’m‚点!"
        Set ArrSheetName = Nothing
End Sub

Lưu ý thêm: Trên các form có các đối tượng (Textbox, Combobox) được đặt tên không hợp lệ nên sẽ rắc rối khi viết và chạy code đấy. Tốt nhất tên của các đối tượng này nên được sử dụng tiếng Anh hoặc tiếng Việt không dấu, không nên dùng tiếng Nhật, tiếng Hàn hay tiếng Thái gì ráo, anh VBA không thích chơi với mấy anh này.

 

[ntngoc123]

Nhờ các bác chỉ giáo em vấn đề này nữa ạ.
Em muốn tạo nút cập nhật dữ liệu từ Listbox và tạo dòng tiêu đề cho Listbox.
Em đã tạo sẵn nút và dòng tiêu đề như trong file nhưng chưa biết viết code cho nó nên nhờ các bác giúp đỡ.
- Khi bấm vào nút "Sua Du lieu" thì dữ liệu sẽ được cập nhật trên file.
- Tiêu đề listbox là hàng thứ 3 (A3, B3, C3)
- Ngoài ra xin giúp em chỉnh lại cho phù hợp Listbox của em bị dư quá nhiều khoảng trắng do em đặt lệnh ở ô Số thứ tự và code vba hiện tại hiểu là hiển thị tới dòng cuối cùng.
Em xin cám ơn ạ.