Xóa hết các Sheet chỉ để lại những sheet theo chỉ định

[kieuhuy_bmt]

Kính gửi các Anh , chị trên GPE!
ở bài này:
http://www.giaiphapexcel.com/forum/...-phải-sửa-Code-thế-nào-ah&p=378244#post378244

Có đoạn Code xóa hết các sheet chỉ để lại "sheet1"

Vậy em muốn sửa Code để giữ lại khoảng 3 sheet theo chỉ định thì phải làm sao? Vì gà mờ nên kiếm mãi trên diễn đàn vần kg áp dụng đc gì, xin mọi người giúp đỡ.

 

[dhn46]

Cấu trúc nó như thế này, bạn tuỳ biến nhé

Sub XoaSheet()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "Sheet1" Or sh.Name <> "Sheet2" Then
            MsgBox sh.Delete
        End If
    Next
End Sub

 

[Quang_Hải]

Cấu trúc nó như thế này, bạn tuỳ biến nhé

Sub XoaSheet()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "Sheet1" Or sh.Name <> "Sheet2" Then
            MsgBox sh.Delete
        End If
    Next
End Sub

Xoá sheet mà thiếu câu lệnh displayalerts thì bị hỏi hoài mệt lắm
Xem hàng lạ đây

Sub XoaSheet()
Application.DisplayAlerts = False
Dim SheetsToKeep, sh, chk
SheetsToKeep = Array("a", "b", "c")
For Each sh In Worksheets
   chk = Filter(SheetsToKeep, sh.Name, 1)
   If UBound(chk) <> 0 Then
      sh.Delete
   End If
Next
Application.DisplayAlerts = True
End Sub

 

[VetMini]

Xoá sheet mà thiếu câu lệnh displayalerts thì bị hỏi hoài mệt lắm
Xem hàng lạ đây

Sub XoaSheet()
Application.DisplayAlerts = False
Dim SheetsToKeep, sh, chk
SheetsToKeep = Array("a", "b", "c")
For Each sh In Worksheets
   chk = Filter(SheetsToKeep, sh.Name, 1)
   If UBound(chk) <> 0 Then
      sh.Delete
   End If
Next
Application.DisplayAlerts = True
End Sub

Biến chk là thừa. Chỉ cần
If UBound(Filter(SheetsToKeep, sh.Name, 1)) <> 0 Then

Thêm nữa, thường thuiờng trong công việc xoá, người ta đếm đếm chỗ còn lại, xem tới một giới hạn nào đó thì dừng. Trong bài này cần đếm xem còn lại 1 thì dừng.

 

[nghiaphuc]

Xin góp vui thêm một cách:
[GPECODE=vb]Sub DeleteSheets()
Dim Ws As Worksheet, SheetsToKeep As String
Application.DisplayAlerts = False
SheetsToKeep = ".Sheet1.Sheet3.Sheet4.Sheet10."
For Each Ws In ThisWorkbook.Sheets
If InStr(1, SheetsToKeep, "." & Ws.Name & ".", vbTextCompare) = 0 Then Ws.Delete
Next
Application.DisplayAlerts = True
End Sub[/GPECODE]

 

[kieuhuy_bmt]

Em làm theo thứ tự từ bài của bác Dhn46 nó báo lỗi
này "02 ảnh" các Bác xem sửa giúp

 

[kieuhuy_bmt]

Em sửa như Ở bài 4 nó báo lỗi này!

 

[kieuhuy_bmt]

Em thay tên sheet vào Code ờ bài 5, nó báo lỗi này. Chắc tại cái File của em có vấn đề, em gửi lên mong các bác tìm nguyên nhân giúp.

 

[Quang_Hải]

Lùa hết sheet nào muốn để lại sang 1 bên, chọn hết các sheet còn lại vào xoá đi là xong chuyện. Tội gì phải hành xác vậy trời

 

[dhn46]

Qua các thử nghiệm của bạn tôi thấy bạn chưa biết nhiều về VBA. Với Code bài #6 bạn chú ý sheet name khác sheet code. Cái sheet1, sheet2 đó là cái sheet name hay hiểu nôm na nó là tên sheet đó bạn.

Bạn tự tuỳ biến nhé.

 

[Quang_Hải]

Em thay tên sheet vào Code ờ bài 5, nó báo lỗi này. Chắc tại cái File của em có vấn đề, em gửi lên mong các bác tìm nguyên nhân giúp.

File bạn có sheet ẩn nên lỗi là phải rồi

Sub XoaSheet()
Application.DisplayAlerts = False
Dim SheetsToKeep, sh, chk
SheetsToKeep = Array("DATA", "Thongtin bao cao")
For Each sh In Worksheets
   chk = Filter(SheetsToKeep, sh.Name, 1)
   If UBound(chk) <> 0 Then
     sh.Visible = True
     sh.Delete
   End If
Next
Application.DisplayAlerts = True
End Sub

 

[kieuhuy_bmt]

File bạn có sheet ẩn nên lỗi là phải rồi

Sub XoaSheet()
Application.DisplayAlerts = False
Dim SheetsToKeep, sh, chk
SheetsToKeep = Array("DATA", "Thongtin bao cao")
For Each sh In Worksheets
   chk = Filter(SheetsToKeep, sh.Name, 1)
   If UBound(chk) <> 0 Then
     sh.Visible = True
     sh.Delete
   End If
Next
Application.DisplayAlerts = True
End Sub

Cảm ơn bác Quanghai1969 nhiều. Vấn đề đã được giải quyết. Tuy nhiên cái Sheet ẩn ấy nó phục vụ cho chương trình tổng hợp dữ liệu vào. Vì nhiều sheet quá (hơn 200 sheet) nên mỗi lần làm lại phải xóa bằng tay nó mất công. Vì vậy mới nhờ đến cai Code xóa Sheet. Bác sửa lại giúp em, chừa thêm hoặc không xóa cái sheet ẩn với.

 

[Quang_Hải]

Cảm ơn bác Quanghai1969 nhiều. Vấn đề đã được giải quyết. Tuy nhiên cái Sheet ẩn ấy nó phục vụ cho chương trình tổng hợp dữ liệu vào. Vì nhiều sheet quá (hơn 200 sheet) nên mỗi lần làm lại phải xóa bằng tay nó mất công. Vì vậy mới nhờ đến cai Code xóa Sheet. Bác sửa lại giúp em, chừa thêm hoặc không xóa cái sheet ẩn với.

Thì xem coi nó tên gì, đưa vào nhóm không xoá là được

 

[kieuhuy_bmt]

Em đã làm được rồi! cảm ơn tất cả nhà.