How to delete multiple workshets

Hi ,

I have .xls files in a folder ( around 100+ excel files).each xls has 20 worksheets . I need to delete all the worksheets from all the xls files except the work sheet by name sheet1. is there a way I can do it in single shot,instead of doing it manually for each xls???

Thx,Deepti

Deepti,

This code will ask you to select a folder. Navigate to the desired folder and highlight it, then press "OK." It will then go through each excel file in that folder and if that file has a sheet named "Sheet1", it will delete all other sheets. At the end, the macro will let you know what workbooks did not have a sheet named "Sheet1".

Here's the code:

Sub WorksheetDeletionMacro_for_Deepti()
    
    Dim strFldrPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        On Error GoTo ExitSub
        strFldrPath = .SelectedItems(1)
    End With

    Dim CurrentFile As String: CurrentFile = Dir(strFldrPath & "\" & "*.xls")
    Dim SheetName As String:   SheetName = "Sheet1"
    Dim FailedWorkbooks As String: FailedWorkbooks = vbNullString
    Dim wb As Workbook, ws As Worksheet
    Application.ScreenUpdating = False
    While CurrentFile <> vbNullString
        Set wb = Workbooks.Open(strFldrPath & "\" & CurrentFile)
        If SheetExists(SheetName, wb) Then
            Application.DisplayAlerts = False
            For Each ws In wb.Sheets
                If ws.Name <> SheetName Then ws.Delete
            Next ws
            Application.DisplayAlerts = True
        ElseIf FailedWorkbooks = vbNullString Then
            FailedWorkbooks = wb.Name
        Else
            FailedWorkbooks = FailedWorkbooks & ", " & wb.Name
        End If
        wb.Close True
        CurrentFile = Dir
    Wend
    Application.ScreenUpdating = True
    
    If FailedWorkbooks <> vbNullString Then MsgBox FailedWorkbooks & " did not have a sheet named " & SheetName & "."
    Exit Sub
    
ExitSub:
    Exit Sub
    
End Sub

Private Function SheetExists(SheetName As String, wb As Workbook) As Boolean
    
    Dim wsCheck As Worksheet
    On Error GoTo NotFound
    Set wsCheck = wb.Sheets(SheetName)
    SheetExists = True
    Exit Function
    
NotFound:
    SheetExists = False
    
End Function

Hope that helps,
~tigeravatar

Hi Tigeravatar
I have the opposite problem - how to write a macro that would delete certain spreadsheet across multiple workbooks (this spreadheet has the same name on almost 1000 identical workbooks I have). Can you please advice?
Daniel

Hi Tigeravatar,
sorry for that! was not aware.
Daniel