Delete all worksheets except the first one

Hi Nithya1987, try

Sub DeleteWorksheets()
    Dim Ws As Worksheet
    
    For Each Ws In Worksheets
        If Ws.Index <> 1 Then
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
        End If
    Next Ws
End Sub

Nithya1987,

Modification to Mordred's code to include all workbooks in the C:\Prod_Dump folder:

Sub tgr()
    
    'Change path as necessary, don't forget the ending \
    Const strFldrPath As String = "C:\Prod_Dump\"
    
    Dim wb As Workbook
    Dim wsIndex As Long
    Dim CurrentFile As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    CurrentFile = Dir(strFldrPath & "*.xls*")
    While CurrentFile <> vbNullString
        Set wb = Workbooks.Open(strFldrPath & CurrentFile)
        For wsIndex = wb.Sheets.Count To 2 Step -1
            wb.Sheets(wsIndex).Delete
        Next wsIndex
        wb.Close True
        CurrentFile = Dir
    Wend
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save