フォルダ内の複数ファイルから特定のシートを一括削除

質問

Excel2003環境です。
　VBの使い方自体まだよく判ってない初心者ですが、質問させてください。

　一つのフォルダ内に、複数（だいたい300くらい）のエクセルファイルがあります。
　これらは、同一の原型ファイルを基にリネームした資料なのですが、これら全てに入っている特定のシートを一括削除したいのですが、その方法を知りたいと思います。

　具体的には、

Sheet1/見積り資料
Sheet2/記入例
Sheet3/部品単価
Sheet4/（Sheet3の内容をVLOOKUPで引っ張っているデータ一覧）

という構成＆シート名です（Sheet4は名称を特に定めてません）。
すべてのファイルに上記シートが設定されてますが、このうち「Sheet3/部品単価」を全て削除したいのです。
勿論、これによりSheet4が崩れても構いません（というか存在は無視します）。
そのような方法はありませんでしょうか？

また、VBのコードと一緒に、それを使用するためにどのような準備をするべきか、そちらもお教えいただければと思います。
（コードの書き込みと保存はわかりますが、上記の場合どこに書き込んでどう保存すべきかよくわかっていません）

以上、どうぞよろしくお願い致します。

回答No.2

K Kazz（@JazzCorp）

’マクロブックがあるフォルダ内のEXCELブックの "Sheet1"と"Sheet2"以外のシートを削除する。
Option Explicit
Const xFileSelector = "*.xls*"
Const xHeader = "BookName,SheetName(Deleted)"
Sub DelSheets()
Dim xPath As String
Dim xName As String
Dim xSheet As Worksheet
Dim zSheet As Worksheet
Dim xFileName As String
Dim xNoData As Boolean
Dim mm As Long
Dim nn As Long
Dim index As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xNoData = True
xName = ActiveWorkbook.Name
Set zSheet = ActiveSheet
zSheet.UsedRange.ClearContents
zSheet.Cells(1, "A").Resize(1, 2).Value = Split(xHeader, ",")
nn = 1
ChDir (ThisWorkbook.Path)
xPath = ThisWorkbook.Path & "\"
xFileName = Dir(xPath & xFileSelector)
Do Until (xFileName = Empty)
If (xFileName <> ThisWorkbook.Name) Then
With Workbooks.Open(xPath & xFileName, UpdateLinks:=False)
mm = mm + 1
For Each xSheet In .Worksheets
If (xSheet.Name = "Sheet1") Or (xSheet.Name = "Sheet2") Then
Else
nn = nn + 1
With zSheet
zSheet.Cells(nn, "A").Value = ActiveWorkbook.Name
zSheet.Cells(nn, "B").Value = xSheet.Name
End With
xSheet.Delete
End If
Next
Workbooks(xFileName).Activate
If Not (ActiveWorkbook.Saved) Then
ActiveWorkbook.Save
End If
ActiveWorkbook.Close
End With
xNoData = False
End If
xFileName = Dir()
Loop
If xNoData = True Then
MsgBox ("No File Found!!")
Else
MsgBox ("Open Books(File) : " & mm & vbNewLine & "Deleted Sheets : " & nn - 1)
End If
Epilogue:
With zSheet
zSheet.Columns("A:B").AutoFit
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

回答No.1

K Kazz（@JazzCorp）

回りくどい表現だが、要はSheet1とSheet2を残し、その他のシートは削除する、ということだね、、、