Как я могу удалить несколько листов из нескольких файлов Excel с именем Лист + номер

Question

У меня есть макрос, в котором я хочу применить проверку данных к каждому файлу Excel в папке, сохранить его и закрыть. Но теперь я обнаружил, что этот макрос будет применяться к первому открытому листу, а не к листу с файлом с именем Name.LastName

У нескольких из этих файлов есть листы типа

• Sheet1
• Sheet2
• Sheet3
• …
• Name.LastName

Как удалить Sheet1,2,3 или как Есть много листов. И только для того, чтобы остаться Name.LastName

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
                 Columns("A:A").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    ActiveWorkbook.Save
    ActiveWorkbook.Close
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Было бы лучше, если бы этот код мог быть реализован здесь как-то

Answer 1

Вам нужно будет выполнить зацикливание рабочего листа на активной рабочей книге. Попробуйте ниже.

Sub LoopThroughFiles()
Dim xFd As FileDialog, xFdItem As Variant, xFileName As String, CrntWbk As Workbook, Ws As Worksheet
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

If xFd.Show = -1 Then
    xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
    xFileName = Dir(xFdItem & "*.xls*")
    Do While xFileName <> ""
        Set CrntWbk = Workbooks.Open(xFdItem & xFileName)
        With CrntWbk
            For Each Ws In CrntWbk.Worksheets
                If Ws.Name = "Name.LastName" Then
                    ' If Worksheet Name is "Name.LastName", it applies the validation
                    With WS.Columns("A:A").Validation
                        .Delete
                        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                        :=xlBetween
                        .IgnoreBlank = True
                        .InCellDropdown = True
                        .ShowInput = True
                        .ShowError = True
                    End With
                Else
                    'Deletes other sheets
                    Application.DisplayAlerts = False
                    Ws.Delete
                    Application.DisplayAlerts = True
                End If
            Next Ws
            .Save
            .Close
        End With
        xFileName = Dir
    Loop
End If