『シートの挿入場所』(ぷりん) シートを挿入する際に日付順に並べ替えを行いたいです。 挿入するシートの前に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.Countcw 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