Hi Doug,
Try the following
Sub DeleteSheetsFromAllBooks()
'===================================
' Based on Ron de Bruin's Sub Copyrange2
' and adapted to replace copy operations
' with the deletion of specified worksheets.
' (For the original macro, see:
'
http://www.rondebruin.nl/copy4.htm)
' ====================================
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook
Dim ws As Worksheet
Dim arr As Variant
Dim i As Long
arr = Array("Sheet2", "Sheet3") '<<=== Sheets to delete. CHANGE
'Fill in the path\folder where the files are
MyPath = "C:\MyFolder" "'<<=== CHANGE
'Add a slash at the end if the user forget
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open _
(MyPath & MyFiles(Fnum))
Application.DisplayAlerts = False
On Error Resume Next ' In case sheet does not exist
For i = LBound(arr) To UBound(arr)
mybook.Sheets(arr(i)).Delete
Next i
mybook.Close savechanges:=True
Next Fnum
CleanUp:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
