Автоматическая фильтрация списка листов, удаление помеченных листов и создание нового обновленного листа из образца листа.

Question

Я впервые делаю снимок в VBA, так что надеюсь, что кто-нибудь сможет помочь. У меня есть большая модель с большим количеством листов, которые взяты из рабочего листа образца шаблона, и в качестве значения указан серийный номер листа на каждом листе и имя рабочего листа в списке основного листа.

Список основного листа состоит из трех столбцов

Номер листа - Имя листа - Флаг удаления

1-- Baby_24-- Да

2-- Baby_36-- Нет

3-- Baby_48-- Нет

4-- Baby_60-- Да

Попытка написать макрос, который проходит по списку основных листов (столбцы от A до C) ), удаляет флажок «Да», удаляет все листы в отфильтрованном наборе данных.

После этого он должен go пройти через тот же список и заново создать листы, скопировав лист и переименовав в главном списке и обновив значение ячейки 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

Answer 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