Sub SubDeleteAllSheets()
'macro to delete sheets of all workbooks in specified directory
'requires reference set to Microsoft Scripting runtime
Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim mySheet As Worksheet
'set path for files - change for your folder
Const myDir As String = "C:\Temp\"
'set up filesys objects
Set FileSys = New FileSystemObject
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file. check if Excel and if so loop through all sheets and delete (except for one)
For Each objFile In myFolder.Files
If Right(objFile.Name, 3) = "xls" Then
Workbooks.Open myDir & objFile.Name
'loop through and delete each sheet
Application.DisplayAlerts = False
For Each mySheet In Workbooks(objFile.Name).Sheets
'cannot delete last sheet therefore check for error
On Error Resume Next
mySheet.Delete
On Error GoTo 0
Next mySheet
'clear all cells in remaining sheet
ActiveWorkbook.Sheets(1).Cells.Clear
Workbooks(objFile.Name).Close savechanges:=True
Application.DisplayAlerts = True
End If
Next objFile
Set FileSys = Nothing
Set myFolder = Nothing
End Sub