不特定のシートをマクロで削除を

質問

いつもお世話になります
WINDOWS7 EXCELL2010 です。

シート「記入」にデーターを入力してそのデーターをいくつかの振分のシートに転記しています。

条件
削除したい
１　0000　　　 の４桁のシート名のいずれかのシートを削除
　　※例えば　１１月４日のシート名は　1104　の４桁になります。
　　　　　　　　１月１日は　0101　となります。
　　　　　　　今月で言えば　1101　～　1130　の３０枚のシートがあります。
削除しない
１　文字名　　 のシートは削除しない
２　1　～　12　のシートは削除しない

上記の削除したいの方法は私なりの考えで２通り考えました。
他にいい方法があればおすすめ願えればありがたいです。

その1～
00 の４桁のシート名が削除の対象ですので、
例えば今月で言いますと　～1031(１０月３１日分)
先月までのシートをマクロで削除する方法
その２～
　　　　　添付図のようにB列に○のあるシートのみをマクロにて削除する方法

抽出するマクロは下記です。
Sub アクティブセルからシート名一覧を作成する()
Dim sh As Object
Dim row_num As Long
Dim col_num As Long
If MsgBox("アクティブセルから下にシート名一覧を作成してもいいですか？", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
row_num = ActiveCell.Row
col_num = ActiveCell.Column
For Each sh In ActiveWorkbook.Sheets
Cells(row_num, col_num).Value = sh.Name
row_num = row_num + 1
Next sh
End Sub

小生の考えの　その１～　その２～　または他の方法でいいアイディアがありましたら御指導いただけませんでしょうか。
宜しくお願いします。

回答No.1

keithin

＞その１～　その２～　または他の方法

他の方法でもよいってことは結局何がヤリタイ／出来たら良いのかというと、何でもいいから４ケタ数字のシートは削除したいってことナンでしょうか。

sub macro1()
　dim w as worksheet
　application.displayalerts = false
　for each w in worksheets
　　if w.name like "####" then
　　’必要に応じてアナタがヤリタイ事を条件として積み込むこと
　　　if left(w.name, 2) <> format(month(date), "00")　then
　　　　w.delete
　　　end if
　　end if
　next
　application.displayalerts = true
end sub

一度ご相談は解決で閉じてから、改めて「こういう結果が欲しい／こうなって欲しい」とご相談を書き直し、新しく投稿しなおしてみて下さい。

お礼

ありがとうごさいました。

補足

早速の御指導ありがとうございます。

私なりに考えたのは
重くなる
いい方法でない
などの観点からいくつか考えその上に何か他の方法であれば思った次第です。

再度自分なりの考えをぶつけさせていただきますので可能なら再指導よろしくお願いします。