删除指定工作表后重新命名剩余表

Sub DeleteAndRenameSheets()

    Dim ws As Worksheet

    Dim deleteSheetNames As Variant

    Dim i As Long

    Dim sheetCounter As Long

    

    ' 提示用户输入要删除的工作表名称（多个名称之间用逗号分隔，不含引号）

    deleteSheetNames = InputBox("请输入要删除的工作表名称（用逗号分隔，例如：Sheet1,Sheet3）")

    

    ' 如果用户没有输入任何内容，则退出子程序

    If deleteSheetNames = "" Then Exit Sub

    

    ' 将输入的字符串按逗号分隔成数组，并去除可能的空格

    deleteSheetNames = Split(Trim(deleteSheetNames), ",")

    

    ' 关闭删除时的警告（如果需要）

    Application.DisplayAlerts = False

    

    ' 遍历数组，删除指定的工作表

    For i = LBound(deleteSheetNames) To UBound(deleteSheetNames)

        On Error Resume Next ' 忽略如果工作表不存在时的错误

        Worksheets(deleteSheetNames(i)).Delete

        On Error GoTo 0 ' 恢复正常的错误处理

    Next i

    

    ' 重新开启删除时的警告

    Application.DisplayAlerts = True

    

    ' 初始化计数器

    sheetCounter = 1

    

    ' 遍历工作簿中的所有工作表，并重新命名它们

    For Each ws In ThisWorkbook.Worksheets

        ws.Name = "" & sheetCounter ' 重命名工作表

        sheetCounter = sheetCounter + 1 ' 增加计数器

    Next ws

    

    ' 显示消息框以通知用户操作已完成

    MsgBox "已删除选定的工作表，并重新命名了剩余的工作表。", vbInformation

End Sub