Excelで、複数ブックの複数シートを削除するマクロを教えて下さい

Excelで、複数ブックの複数シートを、ブック名、シート名を指定して削除するマクロを教えて頂けないでしょうか？対象のブックは複数あり、ひとつづつシートの削除処理をするところを自動化したいと思っています。宜しくお願い致します。

質問者からの補足コメント

• 

  yokomaya様　早速のアドバイス、ありがとうございます。知識がないので、「セルにリストを準備しておけば、ここでは直接文字列を与えている部分にセルの文字列を.Textプロパティで渡すこともできますから、リストをシート上に作ればループでいくらでも消せます。」の具体的な設定方法がわかりません。素人で申し訳ないです。
  例えば、マクロ管理シートなるものを作成しＡ列に対象ブック名、Ｂ列に削除したい対象シート名を入力した場合、「Workbooks("Honyaraka.xlsx").Sheets("Sheet3").Delete」ではどのようなＶＢＡを記述すれば良いのでしょうか？？

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/06/15 13:10

• 

  TH69様　早速のアドバイス、ありがとうございます。他の業務も自動化するよう、いくつかマクロが入ったＥｘｃｅｌブックに、「指定シート削除」のマクロも加えたいと思っています。そのブックに管理シートなるものがあり、そのＡ列に対象ブック名、Ｂ列に削除したいシート名を記述し、マクロを実行したいと考えています。対象ブックの保存先は同一フォルダ内を想定しています。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/06/15 13:21

• 

  tom04様　具体的にマクロの記載をして頂き有難うございます。試してみようと思いますが・・『コード内の「★」の行　「保存場所のパス」は実際の保存場所のパス』とありますが、このマクロを格納しているエクセルの保存場所のことでしょうか？ドキュメント内に「マクロテスト」というフォルダを作成していて、そこにマクロを書き込んだエクセルブックを入れる場合は、「C:/Users/〇〇〇/Documents/マクロテスト」を★と入れ替えるのですか？基本的なこともわからずすみません、。
  また、このブックとマクロテストのフォルダを別の場所に動かすたびに、保存場所のパスの記述を変更しないといけないのでしょうか？？

  No.6の回答に寄せられた補足コメントです。 補足日時：2017/06/15 23:28

• 

  tatsu99様　以前も助けて頂きましたね。ありがとうございます。tatsu99様の説明が素人の私でもとても分かりやすく表現してくれるので助かります。
  対象となるブックは一か所のフォルダに集めてもいいのですが、C列に格納FLDを記述するスタイルの方が、汎用性があって使いやすそうです。
  拡張子は常時表示しています。またExcelはxlsxとxlsmのみ使用しています。
  tatsu99様が以前提供してくれたマクロは大変に重宝して現在も頻繁に利用させて頂いています。その作業の一環で、シートの集約、分散作業をした後に、分散先でシートの削除が必要となるケースが出てきた為に、今回の質問をさせて頂いています。よろしくお願いいたします。

  No.10の回答に寄せられた補足コメントです。 補足日時：2017/06/21 21:58

No.11 ベストアンサー 回答者： tatsu99 回答日時： 2017/06/21 23:53

No10です。

標準モジュールに以下のマクロを登録してください。
A列2行以降がブック名
B列2行以降が削除シート名
C列2行以降がブックが格納してあるフォルダ名
D列2行以降が削除結果
になります。添付資料参照。
このシート名は”管理シート”になります。
黄色部分がマクロ実行前にあなたが設定する箇所です。
拡張子は、xlsx,xlsmのみ有効です。
------------------------------------------------------
Option Explicit

Public Sub 指定シート削除()
Dim sh As Worksheet
Dim exec_count As Long
Dim maxrow As String
Dim result As Boolean
If MsgBox("各ブックのシートを削除します", vbOKCancel) = vbCancel Then Exit Sub
Dim row As Long
Set sh = Worksheets("管理シート")
maxrow = sh.Cells(Rows.count, 1).End(xlUp).row 'sheetの最大行取得
exec_count = 0
Application.ScreenUpdating = False
For row = 2 To maxrow
result = Sakujo(row, sh)
ThisWorkbook.Activate
If result = True Then
sh.Cells(row, "D").Value = "削除成功"
exec_count = exec_count + 1
Else
sh.Cells(row, "D").Value = "削除失敗"
End If
Next
Application.ScreenUpdating = True
MsgBox ("削除処理完了　処理件数=" & exec_count)
End Sub

'削除処理
Private Function Sakujo(ByVal row As Long, ByVal sh As Worksheet) As Boolean
Dim bookName As String '分散ブック名
Dim sheetName As String '分散シート名
Dim bookpath As String '分散ブック名（完全パス）
Dim bookfolder As String '分散ブック格納フォルダ名
Sakujo = False
ThisWorkbook.Activate
bookName = sh.Cells(row, "A").Value
sheetName = sh.Cells(row, "B").Value
bookfolder = sh.Cells(row, "C").Value
If CheckBookName(bookName) = False Then
MsgBox (bookName & "はサポートしません。")
Exit Function
End If
If dir(bookfolder, vbDirectory) = "" Then
MsgBox ("フォルダ名=" & bookfolder & "は存在しません。")
Exit Function
End If
bookpath = bookfolder & "\" & bookName
If dir(bookpath) = "" Then
MsgBox ("ブック名=" & bookpath & "は存在しません。")
Exit Function
End If
Workbooks.Open bookpath
Workbooks(bookName).Activate
If ExistsWorkSheet(sheetName) = False Then
MsgBox (bookName & "中に" & sheetName & "は存在しません")
Workbooks(bookName).Close SaveChanges:=False
Exit Function
End If
If Worksheets.count = 1 Then
MsgBox (bookName & "中の" & sheetName & "は１つのシートしかないので削除できません")
Workbooks(bookName).Close SaveChanges:=False
Exit Function
End If
Application.DisplayAlerts = False
Worksheets(sheetName).Delete
Application.DisplayAlerts = True
Workbooks(bookName).Close SaveChanges:=True
Sakujo = True
End Function

'ブック名のチェック
Public Function CheckBookName(ByVal bname As String) As Boolean
CheckBookName = False
'拡張子を取得
Dim pos As Variant
Dim ext As String
pos = InStrRev(bname, ".")
If pos > 0 Then
ext = UCase(Right(bname, Len(bname) - pos))
If ext = "XLSX" Or ext = "XLSM" Then
CheckBookName = True
End If
End If
End Function
'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetName As String) As Boolean
Dim ws As Worksheet
ExistsWorkSheet = False
For Each ws In Worksheets
If UCase(ws.Name) = UCase(sheetName) Then
ExistsWorkSheet = True
Exit Function
End If
Next ws
End Function
-------------------------------------------------------

この回答へのお礼

tatsu99様　ご連絡が遅くなりました。やっと本日頂いたマクロを実装し動作確認をさせて頂きました。完璧です！こちらの希望した作業が簡単にできました。このような作品は、やはり知っている方に作成頂くのが完璧ですね。作られる方は大変でしょうが、まるでマジックを見ているように作業の自動化が図れます。お見事です！　本当にありがとうございました！

お礼日時：2017/07/04 16:08

No.10 回答者： tatsu99 回答日時： 2017/06/16 11:02

>例えば、マクロ管理シートなるものを作成しＡ列に対象ブック名、Ｂ列に削除したい対象シート名を入力し

ということですが、対象となるブックは、一か所のフォルダに格納されているのですか、それとも、ばらばらですか。もし、ばらばらなら、C列に格納フォルダの指定が必要です。もし、一か所なら、1行目のどこかに
その格納フォルダを記述し、2行目が見出し、３行目からデータ（A列ブック名　B列シート名）にすればよいかと。

又、あなたのパソコンは拡張子を常時表示していますか。もし、拡張子を表示しないと、ブックの正しい名称が判らなくなります。
book1.xls
book1.xlsm
book1.xlsx
これは、全てbook1ですが異なるものです。
拡張子を表示するようにしてください。その方法が判らない場合は、補足ください。
"拡張子 表示"で検索すれば、いろいろ出てきます。
削除するブック名は、拡張子を含めて指定するようにします。
例　book1ではなくbook1.xlsxと指定します。
拡張子を含めて指定する場合、今でも、xlsを使用していますか。
通常は、xlsは使用しないので、拡張子は、xlsxとxlsmのみOKとしたほうが安全です。

No.9 回答者： tom04 回答日時： 2017/06/16 09:19

No.６です。

＞「保存場所のパス」は実際の保存場所のパス』とありますが、このマクロを格納しているエクセルの保存場所のことでしょうか？

特定のフォルダにファイルをまとめるのが一般的だと思います。
パスの確認方法として、保存場所のフォルダを開く　→　その中のどのファイル（ブック）でもよいのでファイルのアイコン上で右クリック　→　プロパティ
「ファイル」のプロパティダイアログボックスが表示されます。
「場所」の部分が保存場所のパスになりますので、
それをそのまま前回のコード内の「保存場所のパス」の部分にコピー＆ペーストすれば大丈夫です。

※　コード記載のExcelファイルと対象ファイルが同じフォルダ内に保存してある場合は
＞myPath = "保存場所のパス" & "\"
を
＞myPath = ThisWorkbook.Path & "\"
としても大丈夫です。m(_ _)m

この回答へのお礼

tom04様　ご回答、ご助言頂いてずいぶんと日にちが経ってしまいました。なかなか、頂いたものを実装できることができず、本日やっといろいろと試してみたのですが、申し訳ございません、、最終的にはtatsu99さんのアドバイスをベストアンサーに選ばさせて頂きました。tom04さんもすぐに回答頂いていたのにすみません。また機会がありましたらご助言頂けると幸いです。ありがとうございました。

お礼日時：2017/07/04 16:18

No.8 回答者： yokomaya 回答日時： 2017/06/15 23:16

念のため付け加えますがトータルたったの４行ですよ。

これを自分ではやりたくないって、
そんなにまで頑ななら、
人に聞いてまですることないと思いますが。

無茶でしょうか？

それと用語ね、判りにくいこと多数あると思います。
短い文章で三つ知らない言葉出てきたら僕も嫌です。
読む気力萎えます。

そこは、わかるんですけど、コードだけは自分で試して欲しいなぁ。

それが理解できるかどうかは、これからのあなたの努力次第
でしょうけど。

結論を急がずにぼちぼち試してもらえたら、
今は理解できなくても、
続けてさえいれば他のテーマも色々とチャレンジしてれば
半年か一年後には或いは３年後、ぼんやりと見えてくるんじゃないかな。

理解するって、そんなスパンで考えるものだと思います。

No.7 回答者： yokomaya 回答日時： 2017/06/15 23:02

みっつも下ですよ。

こちらはお爺さんだな。

＞「Workbooks("Honyaraka.xlsx").Sheets("Sheet3").Delete」ではどのようなＶＢＡを記述すれば良いのでしょうか？？

と訊かれたので、そこを----に当てはめて
"Honyaraka.xlsx"→rg.text
"Sheet3"→rg.offset(0,1).text
とするだけですよ。

ほぼ答えそのものなんだけど。

勿論、一朝一夕に意味が判ったら、逆に空恐ろしいし
（こっちはどんなにかかってるか・・・。）

ただ、自分で触ってみなきゃ、どんなに人のを見ても訊いても
身に付かないことを、知っているので。

是非ぶつかって乗り越える努力を期待したいです。

No.6 回答者： tom04 回答日時： 2017/06/15 22:05

こんばんは！

すでに回答は出ているので参考程度で・・・

マクロのコードを記載するブックのSheet1に↓の画像のような配置で
A列にファイル名、B列に削除するシート名を羅列しているとします。
ファイルはExcel2007以降としています。（拡張子を .xlsx　としている）

標準モジュールです。

Sub Sample1()
Dim i As Long, j As Long, k As Long, wB As Workbook
Dim myPath As String, fN As String, sN As String
myPath = "保存場所のパス" & "\" '//★//
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
fN = .Cells(i, "A") & ".xlsx"
If Dir(myPath & fN) <> "" Then
Workbooks.Open myPath & fN
Set wB = ActiveWorkbook
For j = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
For k = wB.Worksheets.Count To 1 Step -1
sN = .Cells(j, "B")
If wB.Worksheets(k).Name = sN Then
Application.DisplayAlerts = False
If wB.Worksheets.Count = 1 Then
Worksheets.Add after:=wB.Worksheets(1)
End If
wB.Worksheets(k).Delete
Application.DisplayAlerts = True
End If
Next k
Next j
wB.Close savechanges:=True
End If
Next i
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub

※　コード内の「★」の行　「保存場所のパス」は実際の保存場所のパスにしてください。

※　すべてのシート名が存在する場合、最低限1シートは必要なので
その辺の処理も考慮してみました。
（B列のシート名は削除されます）m(_ _)m

No.5 回答者： TH69 回答日時： 2017/06/15 16:17

FileSystemObject勉強中なので、それを使って考えてみました。

不必要なら読み飛ばして下さい。

結構長くなりました（汗）
ブック名とシート名が入力されているシートがアクティブであるとしています。
またシート名はA列のブックに対し複数のシートがある場合はB列、C列・・・と記入するものとします。
マクロを記入するブックとシートを削除するブックは同じフォルダにあるものとします。

ws=アクティブシートとし
a=wsのA列最終行番号
myPath=アクティブブックのパスとします。
iのループでwsの2行目からa行目まで
b=wsのi行A列の値（ブック名）
c=wsのi行最終列番号とし、
条件分岐で、cが1以上なら（シート名記入あり）
条件分岐で、FSOでbのブックが存在するかどうか調べ
存在したらブックbを開き、
jのループで2列目からc列目まで
d=wsのi行j列の値（シート名）とし、
エラーがでたら次へ進み、警告を表示しない設定で、
ブックbのシートdを削除します。
次のjをループします。
エラーの場合は（多分当該シートが見つからないなので）
「シートdが見つかりません」と表示します。
jのループが終了したら、次のiをループします。

Sub test()
Dim a, b, c, d, i As Long, j As Long, ws As Worksheet
Dim myPath As String, myFile As Object
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ws = ActiveSheet
a = ws.Cells(Rows.Count, "A").End(xlUp).Row
myPath = ThisWorkbook.Path & "\"
For i = 2 To a
b = ws.Cells(i, "A").Value
c = ws.Cells(i, Columns.Count).End(xlToLeft).Column
If c > 1 Then
If FSO.FileExists(myPath & b) = True Then
Workbooks.Open FSO.GetFile(myPath & b), ReadOnly:=False
For j = 2 To c
d = ws.Cells(i, j).Value
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(d).Delete
Application.DisplayAlerts = True
If Err.Number <> 0 Then
MsgBox "シート「" & d & "」が見つかりません", vbExclamation
On Error GoTo 0
End If
Next j
ActiveWorkbook.Close SaveChanges:=True
Else
MsgBox "ブック「" & b & "」が見つかりません", vbExclamation
End If
End If
Next i
End Sub


私からもヒントを…。
VBEの画面にローカルウインドウを表示させF8キーでステップ実行すると、どの変数に何の値が格納されているのかなどが分かり、とても参考になります。yokomaya 様のブレークポイントとともに、マクロの動作確認をしながら勉強されることをお勧めします。

この回答へのお礼

TH69様　VBAの書き出しをして頂き、有難うございます。yokomaya様の回答にもお礼でお話しをさせて頂きましたが、当方58歳のおじさんでして、VBAを学ぶという状態ではなく、仕事で使用するエクセルファイルの処理自動化を、知識のある人に助けてもらいたい、という図々しいことなのでございます。専門的なこと、皆さんにとって常識と思われる記述もまったくわかりません・・・。お手数をおかけしました。ありがとうございました。

お礼日時：2017/06/15 22:56

No.4 回答者： yokomaya 回答日時： 2017/06/15 15:31

ヒントを追加しておきます。

一気にdeleteに進むのではなく
一旦
msgbox rg.text & ":" & rg.offset(0,1).text
としてみると、どんな文字列が双方に表示されているかを
確認することが出来ます。

また、コードの左側に幅数ｍｍの帯状の部分ありますよね。
ここをクリックすると茶色の丸が付いて
実行するとそこの行を実行直前で強制中断されます。

この丸を付ける操作をブレークポイントを設定するといいます。

for each の行にブレークポイントを設定して中断したら
イミディエイトウィンドウに

? worksheets("マクロ管理シート").usedrange.address
? worksheets("マクロ管理シート").usedrange.columns(1).address
? worksheets("マクロ管理シート").usedrange.columns(1).cells.address
と、それぞれ入力してみて、セル番地がどうなっているかを
確かめると、一気に理解しやすくなります。

このブレークポイントを設定して、途中で値を確認することは
マクロを身に着けるうえで、とても大事なので
説明しておきたいと思いました。

この回答へのお礼

yokomaya様　ご指導、ありがとうございます。自分で、できるようになるのが一番いいのでしょうが、当方58歳のおじさんでして、基本的なこともわからないので、いつもこの「教えてgoo」で、ほとんど完成形のものを、みなさんの暖かい救いの手で作って頂き、助けてもらっています。作って頂いたものは仕事で使用するのですが、大変に助かっています。専門的に勉強をされてきた方、実践でVBAを駆使されてきた方は、素晴らしいですね。残念ながら現在の私は、yokomaya様が書いて頂いた、ヒントの中の言葉の意味もわかりません。そのレベルでの質問者です。ありがとうございました。

お礼日時：2017/06/15 22:42

No.3 回答者： yokomaya 回答日時： 2017/06/15 13:59

＞知識がないので

誰でも最初は知識などありません。
問題は知識を身に着けていくおつもりか、そうでないのかです。

ＥＸＣＥＬのＶＢＡにおいてセルの処理をスキップして出来ることって
どれくらいあるでしょう？

最初にマスターすべきことのひとつではないでしょうか？

私の記述は
dim rg as range
for each rg in worksheets("マクロ管理シート").usedrange.columns(1).cells
--------------------------------------------
next

で-----の部分に
rg.textとrg.offset(0,1).textを使って
与えるものです。

あえてコピペできる形をとらないのは
考えてほしいからです。
マクロは訊いただけでは絶対に身に付きません。
自ら書いて乗り越えていく、達成感なくして
続くものでもないです。

健闘を祈ります。

No.2 回答者： yokomaya 回答日時： 2017/06/15 12:29

削除自体はとても簡単ですし、マクロ記録すれば誰でも

Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
こんなコードが得られます。
実はマウス操作するのでselectが入ってしまいますが
Sheets("Sheet3").Delete
で十分です。
これはこのブックなので前に何もつきませんが
他のブックの場合なら
Workbooks("Honyaraka.xlsx").Sheets("Sheet3").Delete
の様な感じです。
セルにリストを準備しておけば、ここでは直接文字列を
与えている部分にセルの文字列を.Textプロパティで
渡すこともできますから、リストをシート上に作れば
ループでいくらでも消せます。
問題はブックやシートの規則性というか、どういう風に選ぶのかを
あなたがコーディングできるかどうかではないかと。