自动过滤工作表列表并删除标记的工作表并从样本表创建新的更新工作表答案

【问题标题】：Auto Filter a sheet list and delete marked sheets and create new updated sheet from a sample sheet自动过滤工作表列表并删除标记的工作表并从样本表创建新的更新工作表
【发布时间】：2020-04-18 16:08:52
【问题描述】：

我是第一次尝试 VBA，希望有人能提供帮助。我有一个大型模型，其中包含许多来自模板示例工作表的工作表，并且每个工作表的值都设置为工作表的序列号，工作表的名称设置为主工作表列表上。

主表列表有三列

图纸编号--图纸名称--删除标志

1-- Baby_24-- 是的

2-- Baby_36-- 没有

3-- Baby_48-- 没有

4-- Baby_60-- 是的

尝试编写一个通过主工作表列表（A 到 C 列）的宏，过滤删除标志“是”，删除过滤数据集中的所有工作表。

完成此操作后，它应该通过相同的列表并通过复制工作表并在主列表中重命名为并将该工作表上的单元格值 B$2$ 更新为主列表中的工作表编号来重新创建工作表。这是我到目前为止所拥有的。

代码生成调试错误，并仅删除集合中第一个过滤的工作表市场“是”，并且永远不会转到下一个工作表。

Sub DeleteSheets()
' Delete Sheets Marked as Yes on SkuGroup Worksheet

    Dim rRange As Range, filRange As Range, Rng As Range
    ' Turn off Alerts
    Application.DisplayAlerts = False
    'Remove any filters
    ActiveSheet.AutoFilterMode = False

    '~~> Set your range
    Set rRange = Sheets("SKU_Groups").Range("A1:C999")

    With rRange
        '~~> Set your criteria and filter
        .AutoFilter Field:=3, Criteria1:="=Yes"

        '~~> Filter, offset(to exclude headers)
        Set filRange = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

        Debug.Print filRange.Address

        For Each Rng In filRange
            '~~> Your Code
            ActiveCell.Value2 = Range("B" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value2
            Sheets(ActiveCell.Value2).Delete
            Next
    End With

    'Remove any filters
    ActiveSheet.AutoFilterMode = False

    ' Turn on Alerts
    Application.DisplayAlerts = True

End Sub

【问题讨论】：

哪一行抛出哪个错误？
什么错误，在哪一行？
Sheets(ActiveCell.Value2).Delete 抛出错误（下标超出范围）

标签： excel vba

【解决方案1】：

无需过滤。试试这个：

Sub DeleteSelectedSheets()
    Dim masterSheetName
    Dim sh As Worksheet
    masterSheetName = "master"
    Sheets(masterSheetName).Select

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim rowNum
    rowNum = 1
    Do Until Cells(rowNum, "B").Value = ""
        If Cells(rowNum, "C").Value = "Yes" Then
            For Each sh In Worksheets
                If sh.Name = Cells(rowNum, "B").Value Then
                    sh.Delete
                    Rows(rowNum).Delete Shift:=xlUp
                    rowNum = rowNum - 1
                    Exit For
                End If
            Next
        End If
        rowNum = rowNum + 1
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

【讨论】：