Viết Code bổ sung tạo Sheet mới! (1 người xem)

[Hong.Van]

Em chào Thầy cô & anh chị!
Hiện nay em có sử dụng code tạo Sheet mới trong một File.
Ví dụ trong File đính kèm, Khi em copy & tạo Tên Sheet mới thì nhiều lúc kg biết tên Sheet này đã được tạo chưa?, Giả sử Sheet Hoc2 đã được tạo, bây giờ chạy code thì nó vẫn tiếp tục tạo Sheet Hoc1(2) (Trong 1 File của em số lượng các Sheet khá nhiều nên em bỏ chế độ Options/Sheet taps nên khó kiểm tra tất cả các sheet)

Sub TaoSh()
Dim AAA As Variant, BBB As Variant
On Error Resume Next
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With
    Sheets("MA").Select
    AAA = Range("A7").Value
    BBB = Range("A8").Value
    Sheets(AAA).Copy Before:=Sheets(2)
    Sheets(AAA & " (2)").Name = BBB
    Sheets(BBB).Range("B9").Select
    Set AAA = Nothing
    Set BBB = Nothing
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Xin vui lòng bổ sung thêm code trên như sau:
Nếu tên sheet mới được tạo ra đã có tồn tại trên File thì code hiển thị thông báo "Da co Sheet nay roi!" (và dĩ nhiên kg cho tạo tên Sheet này nữa). Còn nếu chưa có thì code vẫn chạy tạo Sheet mới bình thường.
Em cảm ơn!

 

[ndu96081631]

Em chào Thầy cô & anh chị!
Hiện nay em có sử dụng code tạo Sheet mới trong một File.
Ví dụ trong File đính kèm, Khi em copy & tạo Tên Sheet mới thì nhiều lúc kg biết tên Sheet này đã được tạo chưa?, Giả sử Sheet Hoc2 đã được tạo, bây giờ chạy code thì nó vẫn tiếp tục tạo Sheet Hoc1(2) (Trong 1 File của em số lượng các Sheet khá nhiều nên em bỏ chế độ Options/Sheet taps nên khó kiểm tra tất cả các sheet)

Sub TaoSh()
Dim AAA As Variant, BBB As Variant
On Error Resume Next
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With
    Sheets("MA").Select
    AAA = Range("A7").Value
    BBB = Range("A8").Value
    Sheets(AAA).Copy Before:=Sheets(2)
    Sheets(AAA & " (2)").Name = BBB
    Sheets(BBB).Range("B9").Select
    Set AAA = Nothing
    Set BBB = Nothing
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Xin vui lòng bổ sung thêm code trên như sau:
Nếu tên sheet mới được tạo ra đã có tồn tại trên File thì code hiển thị thông báo "Da co Sheet nay roi!" (và dĩ nhiên kg cho tạo tên Sheet này nữa). Còn nếu chưa có thì code vẫn chạy tạo Sheet mới bình thường.
Em cảm ơn!

Viết lại toàn bộ:

Function SheetExist(ByVal WshName As String) As Boolean
  On Error Resume Next
  SheetExist = Not ThisWorkbook.Sheets(WshName) Is Nothing
End Function

Function isValidWshName(ByVal WshName As String) As Boolean
  If Len(WshName) > 31 Or WshName = "" Then Exit Function
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\\:\][/?*]"
    isValidWshName = Not .Test(WshName)
  End With
End Function

Sub TaoSh()
  Dim AAA As String, BBB As String
  On Error Resume Next
  AAA = Sheets("MA").Range("A7").Value
  BBB = Sheets("MA").Range("A8").Value
  If SheetExist(AAA) Then
    If Not SheetExist(BBB) Then
      If isValidWshName(BBB) Then
        Sheets(AAA).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = BBB
      Else
        MsgBox "Ten sheet không hop le"
      End If
    Else
      MsgBox "Sheet '" & BBB & "' da ton tai"
    End If
  Else
    MsgBox "Sheet '" & AAA & "' không ton tai"
  End If
  Sheets("Ma").Select
End Sub

 

[Hong.Van]

Em cảm ơn sự giúp đỡ của Thầy!
Khi sử dụng code này thì không sử dụng chế độ Format/Sheet/Unhide, nếu không nó chạy không đúng.
VD: Trong File của em có ẩn Sheet1, bây giờ em lấy Sheet "Lop01" để copy và tạo Sheet mới "Lop02", Kết quả nó tạo ra Sheet "Lop01(2)" & làm thay đổi tên Sheet bị ẩn "Sheet1" thành tên "Lop02"
Em cảm ơn!

 

[ndu96081631]

Em cảm ơn sự giúp đỡ của Thầy!
Khi sử dụng code này thì không sử dụng chế độ Format/Sheet/Unhide, nếu không nó chạy không đúng.
VD: Trong File của em có ẩn Sheet1, bây giờ em lấy Sheet "Lop01" để copy và tạo Sheet mới "Lop02", Kết quả nó tạo ra Sheet "Lop01(2)" & làm thay đổi tên Sheet bị ẩn "Sheet1" thành tên "Lop02"
Em cảm ơn!

Bạn sửa dòng
Sheets(Sheets.Count).Name = BBB
Thành:
ActiveSheet.Name = BBB
xem thế nào nhé

 

[ThuNghi]

Bạn sửa dòng
Sheets(Sheets.Count).Name = BBB
Thành:
ActiveSheet.Name = BBB
xem thế nào nhé

Tôi cũng đã từng tạo sh mới, vd như trường có # 100 lớp. Chưa nói đến việc tạo quá 256 sh, chỉ tạo chừng 100 sh thì máy hay bị treo nên phải dùng thêm điều kiện nếu tạo 1 lần 20 sh thì save file và làm tiếp.
Có cách gì khắc phục vấn đề này.

 

[ndu96081631]

Tôi cũng đã từng tạo sh mới, vd như trường có # 100 lớp. Chưa nói đến việc tạo quá 256 sh, chỉ tạo chừng 100 sh thì máy hay bị treo nên phải dùng thêm điều kiện nếu tạo 1 lần 20 sh thì save file và làm tiếp.
Có cách gì khắc phục vấn đề này.

Mình nghĩ với Excel 2010 + Windows 7 chắc không có vụ này xảy ra
Tuy nhiên, theo ý kiến cá nhân thì ta nên:
- Tạo sheet trắng trước (tạo 1 lần nhiều sheet và đặt tên luôn)
- lấy dữ nguồn, gán vào các sheet mới tạo nhưng không dùng phương pháp Copy/Paste và dùng cách gán Array