複数の条件でVBAによるシートの並びえ変え

質問

いつもお世話になります。
WIN7 EXCELL2010 です。
シート数が多くなると並び替えが大変で何とかして省力化を図りたいです。
インターネットのVBAでシートでシートの並び替えをいろいろ調べましたがただ単純に　昇順　降順　でした。
もう少し工夫したVBAが可能ならばと下記のように考え御指導を仰ぎたいです。

御指導を仰ぎたいのは、
参照図で説明しますと　下側　が今月の並びです。
上側が　来月です。
だから　マクロで　下側　から　上側　のようにシートの並び替えがマクロで可能でしょうか。
もしも可能ならご教授いただけませんでしょうか。

条件　1
シート名「記入」　は一番左側に
条件　2
シート名「祭日」　は一番右側に
条件　3
例えば今月の場合、　08　が　「記入」右側　その右から　0801　0802　0803　0804　という具合に
9月になると　例えばコマンドボタンで　09　が　「記入」右側　その右から　0901　0902　0903　0904　です
※ 1月～12月分があって途中で重くなることもあって過ぎたシートは適時削除します。

参考に 下記マクロはすでに適用しています。
1)
シート名のマクロ　(A1に文字列の数字　例えば今日ですと　20140802　08　で文字列です)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$A$1" Then
Call StName_change(Sh, Target.Value)
End If
End Sub
Private Sub StName_change(Sh As Object, word As String)
On Error GoTo era
Sh.Name = word
Exit Sub
era:
MsgBox word & "は無効な名前です"
End Sub
2)
該当日　該当月の色付けマクロ
Private Sub Workbook_Open()
Dim mySheet As Worksheet
For Each mySheet In Worksheets
mySheet.Tab.ColorIndex = xlNone
If mySheet.Name = Format(Now(), "mmdd") Or mySheet.Name = Format(Now(), "mm") Then
mySheet.Tab.ColorIndex = 3
End If
Next
End Sub

何かむつかしい質問をしていますが是非是非ご協力いただけませんでしょうか。

回答No.1

keithin · ベストアンサー

＞にシートの並び替えがマクロ

sub macro1()
　dim d as integer
　worksheets("記入").move before:=worksheets(1)
　worksheets(format(now, "mm")).move after:=activesheet

　on error resume next
　for d = 1 to 31
　worksheets(format(now, "mm") & format(d, "00")).move after:=activesheet
　next d
　on error goto 0

　worksheets("祭日").move after:=worksheets(worksheets.count)
end sub

お礼

早速の御指導誠に有難うございます。
上手くできて感謝感謝です。