> シート見出しをドラッグしかないのでしょうか?
> 急いでいます。
急いでいるなら、そのようにすれば、早いと思いますが・・・
ただ、ブック、シート数が多いとか、頻繁に繰り返す場合は、マクロを使うことに
なるかと思います。
次のマクロを実行すると、ご希望通り、シートが並べ替えられると思います。
シート名を、その名称の共通部分に付加される数値でシートを並べ替えます。
共通部分を指定しないときは、シート名を「振り仮名順」で並べ替えます。
ただし、この場合は、MS-IMEを使用しているものとします。
共通部分を指定した場合、その前後ともに数字がある場合は、双方の数字を
連結した値を基準に整列します。(つまり、前に付いても、後ろについてもOKです。)
Excel2000か、それ以降に対応します。
これでソート出来たと思いますが、如何でしょうか。
Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Const UpDown = 2 ' <---- 1=昇順 / 2=降順 を指定
Const Kyotu = "Sheet" ' <----- 共通名称(小/大文字を識別) 無しは""のみ
Application.ScreenUpdating = False
Sheets.Add Before:=Worksheets(1)
Set Wwh = ActiveSheet
With Wwh
.Visible = False
For N = 2 To Worksheets.Count
.Cells(N - 1, 1).Value = Worksheets(N).Name
If Kyotu <> "" Then
.Cells(N - 1, 2).Value = _
Replace(.Cells(N - 1, 1).Value, Kyotu, "")
End If
.Cells(N - 1, 2).Value = _
Application.GetPhonetic(.Cells(N - 1, 2).Value)
Next N
If UpDown <> 2 Then
.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
Else
.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
Order1:=xlDescending, Header:=xlNo, OrderCustom:=1
End If
For N = 1 To .Range("A1").End(xlDown).Row
Worksheets(.Cells(N, 1).Text).Move After:=Sheets(N)
Next N
End With
For N = 2 To Worksheets.Count
If Worksheets(N).Visible = xlSheetVisible Then
Worksheets(N).Activate
Exit For
End If
Next N
Application.DisplayAlerts = False
Wwh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub
お礼
これが一番簡単ですね! 有難うございました!!