Xóa Sheet cũ, tạo sheet mới

[AnhThu-1976]

Chào các anh, chị & các bạn
Em có record nhưng không thành công
Công việc của em như sau:
Trong 1 file có nhiều sheet như: QuyI, QuyI (1), ... Trong đó sheet QuyI (1) có thể tồn tại hoặc không
Bước 1: Delete sheet QuyI (1) ( nếu có thì delete, còn không có thì bỏ qua)
Bước 2: Từ sheet QuyI sẽ tạo ra 1 sheet mới là QuyI (1) (tạo sheet mới trong cùng 1 file)
Em cảm ơn!

 

[snow25]

Chào các anh, chị & các bạn
Em có record nhưng không thành công
Công việc của em như sau:
Trong 1 file có nhiều sheet như: QuyI, QuyI (1), ... Trong đó sheet QuyI (1) có thể tồn tại hoặc không
Bước 1: Delete sheet QuyI (1) ( nếu có thì delete, còn không có thì bỏ qua)
Bước 2: Từ sheet QuyI sẽ tạo ra 1 sheet mới là QuyI (1) (tạo sheet mới trong cùng 1 file)
Em cảm ơn!

Bạn kiểm tra xem có chưa rồi xoá thôi.Nhưng vấn đề là bạn muốn xoá nhiều hay chỉ 1 thôi.Giờ bạn đưa file lên xem nào.

 

[HeSanbi]

Bạn có thể xem qua code của tôi.
Sử dụng: CopySheetReName "QuyI", "QuyI1", True
Code sẽ copy Worksheet "QuyI" thành "QuyI1" nếu đặt bDel là True, thì cho phép xóa Sheet "QuyI1" khi tìm thấy và Copy "QuyI".
Phương pháp Copy này sẽ đổi cả Properties CodeName của Worksheet. Trong VBProject, thường thì sheet2(QuyI1), với phương pháp này thì sẽ là QuyI1(QuyI1).
Sử dụng Properties CodeName sẽ giúp viết Code VBA gọn hơn, ví dụ: QuyI1.Range("A1") thay cho Sheets("QuyI1").Range("A1")
Hàm bổ trợ:
+ DupliNameSheet: xét xem Worksheet đã tồn tại hay không
+ PlaceShAlphabet: Tính xem vị trí Copy sheet theo thứ tự Alphabet

Copy code bên dưới vào Code Module:

Sub test_CopySheetReName()
  CopySheetReName "QuyI", "QuyI1", True
End Sub
Sub CopySheetReName(FromSh$, NameNew$, Optional bDel As Boolean = False)
  If FromSh = vbNullString Or NameNew = vbNullString Then Exit Sub
    If DupliNameSheet(NameNew) Then
      If bDel Then
        Application.DisplayAlerts = False
        Sheets(NameNew).Delete
        Application.DisplayAlerts = True
      Else
        Exit Sub
      End If
    End If
    If PlaceShAlphabet(NameNew) <> 0 Then
        Sheets(FromSh).Copy After:=Sheets(PlaceShAlphabet(NameNew))
        Sheets(PlaceShAlphabet(NameNew) + 1).Name = NameNew
    Else
        Sheets(FromSh).Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = NameNew
    End If
    With Sheets(NameNew)
        .Parent.VBProject.VBComponents(.CodeName) _
        .Properties("_CodeName") = NameNew
    End With
End Sub
    Private Function PlaceShAlphabet&(ByVal Name As String, Optional numStart& = 1)
        If Name = vbNullString Then PlaceShAlphabet =0: Exit Function
        Dim k&: For k = numStart To Sheets.count
            If Sheets(k).Name > Name Then PlaceShAlphabet = k - 1 : Exit Function
        Next
    End Function
    Private Function DupliNameSheet(ByVal Name As String) As Boolean
        If Name = vbNullString Then DupliNameSheet = True: Exit Function
        Dim wSheet As Worksheet
        For Each wSheet In Worksheets
            If UCase$(wSheet.Name) = UCase$(Name)  Then DupliNameSheet = True:Exit Function
        Next wSheet
    End Function