RemoveSheetsButMe

gistfile1.vb

Set objWorkbook = WScript.GetObject("d:\tmp\sample.xls")
Set objApp = objWorkbook.Application
sheetName = "Sheet1"
objApp.DisplayAlerts = False

count = objWorkbook.Worksheets.Count
for i=count to 1 step -1
  if objWorkbook.Worksheets(i).Name <> sheetName then
    objWorkbook.Worksheets(i).Select
    objWorkbook.Worksheets(i).Delete
  else
    msgbox "Don't kill me"
  end if
next

msgbox "Done."

objWorkbook.Worksheets(sheetName).Select
objWorkbook.Worksheets(sheetName).Visible= -1 'xlSheetVisible

Set app = objWorkbook.Application
app.Windows(1).Visible=True

msgbox cstr( objWorkbook.Worksheets.Count )
' It does saved.
'objWorkbook.SaveAs "d:\tmp\output.csv", 6
objWorkbook.SaveAs "d:\tmp\output.xls", -4143 ' save as normal

objWorkbook.Close
Set objWorkbook = Nothing
objApp.Quit