[[20181219164134]]　『シートの挿入場所』（ぷりん）　ページの最後に飛ぶ

『シートの挿入場所』（ぷりん）

シートを挿入する際に日付順に並べ替えを行いたいです。
挿入するシートの前に7つのシートがあります。
自分なりに行った結果月は順番になるのですが、日付がバラバラになってしまいます。日付も順番にはなりますでしょうか？

現状のマクロです。

Private Sub Worksheet_Active()

     Dim cw As String,i As Long,j As Long,sheetname As String,flag As Long,s As Long
     Application.ScreenUpdating=False
     Application.EnableEvents=False
     flag=0

     With Sheets("予約表")
          '全ての予約のチェック
          For i=3 To .Cells(.Rows.Count,"A").End(xlUp).Row
          flag=0
               'フォーマットの変更
               cw=Format(.Cells(i,"A").Value,"m月d日")
               '同じ日付の名前のシートがあるかどうかのチェック
               For j=1 To Sheets.Count
                    If Sheets(j).Name=cw Then
                          Exit For
                    End If
               Next j
               '同じ日付の名前のシートがなかった場合
               If Sheets.Count<j Then
                    'シートが8枚未満の場合
                    If Sheets.Count<8 Then
                         'オリジナルのコピー
                         Sheets("オリジナル").Copy after:=Sheets(Sheets.Count)
                         'シート名を日付に変更
                         Sheets(Sheets.Count).Name=cw
                         'A1に日付を入力
                         Sheets(Sheets.Count).Range("A1")=cw
                         '売上詳細のコピー
                         Sheets("オリジナル売上詳細").Copy after:=Sheets(Sheets.Count)
                         'シート名の変更
                         Sheets(Sheets.Count).Name=cw & ("売上詳細")
                         'A1に日付を入力
                         Sheets(Sheets.Count).Range("A1")=cw
                    Else
                         'シートが8枚以上の場合
                         sheetname=Sheets(8).Name
                         '一番早い日付のシート(シート8)より前の日付の場合
                         If sheetname>cw Then
                              'オリジナルのコピー
                              Sheets("オリジナル").Copy after:=Sheets(7)
                              'シート名を日付に変更
                              Sheets(8).Name=cw
                              'A1に日付を入力
                              Sheets(8).Range("A1")=cw
                              '売上詳細のコピー
                              Sheets("オリジナル売上詳細").Copy after:=Sheets(8)
                              'シート名の変更
                              Sheets(9).Name=cw & ("売上詳細")
                              'A1に日付を入力
                              Sheets(9).Range("A1")=cw
                         '一番早い日付のシートより後の日付の場合
                         Else
                              For s=8 To Sheets.Count-1 Step 2
                                   sheetname=Sheets(s).Name
                                   If sheetname>cw Then
                                        'オリジナルのコピー
                                        Sheets("オリジナル").Copy after:=Sheets(s-1)
                                        'シート名を日付に変更
                                        Sheets(s).Name=cw
                                        'A1に日付を入力
                                        Sheets(s).Range("A1")=cw
                                        '売上詳細のコピー
                                        Sheets("オリジナル売上詳細").Copy after:=Sheets(s)
                                        'シート名の変更
                                        Sheets(s+1).Name=cw & ("売上詳細")
                                        'A1に日付を入力
                                        Sheets(s+1).Range("A1")=cw
                                        flag=1
                                        Exit For
                                   End If
                              Next s
                              '一番遅い日付のシートより後の日付の場合
                              If flag=0 Then
                                    'オリジナルのコピー
                                   Sheets("オリジナル").Copy after:=Sheets(Sheets.Count)
                                   'シート名を日付に変更
                                   Sheets(Sheets.Count).Name=cw
                                   'A1に日付を入力
                                   Sheets(Sheets.Count).Range("A1")=cw
                                   '売上詳細のコピー
                                   Sheets("オリジナル売上詳細").Copy after:=Sheets(Sheets.Count)
                                   'シート名の変更
                                   Sheets(Sheets.Count).Name=cw & ("売上詳細")
                                   'A1に日付を入力
                                   Sheets(Sheets.Count).Range("A1")=cw
                              End If
                         End If
                    End If
               End If
          Next i
     End With
     Application.ScreenUpdating=True
     Application.EnableEvents=True
End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

1月と11,12月とか、月も思ったようになっていなかったりしませんか？

ぱっと見ですが、cwを決める際、"m月d日" とフォーマット指定していますが、"mm月dd日" とすれば文字長が固定になり、思い通りの数字の大小比較ができるようになるかと思います。
（???） 2018/12/19(水) 17:32

 昔作ったサンプルです。
 参考になるかな、、、

 Sub 日付のシート名を昇順に並び替える()
    Dim Sh As Worksheet, i As Long, J As Long
    '新規シートを作成(作業用)
    With Worksheets.Add
        '日付のシート名を作業用シートのA列に抽出
        .Range("A:A").NumberFormatLocal = "@"
        For Each Sh In Worksheets
            If IsDate(Sh.Name) Then
                J = J + 1
                .Cells(J, "A") = Sh.Name
            End If
        Next Sh
        '作業用シートA列を昇順に並び替える
        .Range("A:A").Sort .Range("A1")
        '作業用シートの順番通りにシートを移動
        For i = 1 To .Range("A1").End(xlDown).Row
            Sheets(.Cells(i, "A").Value).Move After := Sheets(Worksheets.Count)
        Next i
        '作業用シートを削除
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
 End Sub

（TAKA） 2018/12/19(水) 18:22

コメント返信：

[ 一覧(最新更新順) ]

[[20181219164134]] 『シートの挿入場所』（ぷりん） ページの最後に飛ぶ

[[20181219164134]]　『シートの挿入場所』（ぷりん）　ページの最後に飛ぶ