◆シートの並べ替え

  もう何十年も前のことです。
  配列の数字を小さい順に並べ替える方法を勉強したことがあります。
  たしか Fortran を始めた頃だと思います。

  If文で 比較演算子( "<" や ">" など)を使って数字の大小を比較して、一つひとつ
  並べ替え(入れ替え)ました。

  シートの並べ替えもそうやって良いのですが、Excelのシートの並べ替えなので、
  Excelの並べ替え機能を使ってみました。

  Sheetの名前をセルに書き出し、Sheetの名前を昇順に並べ替えて、その結果でシートを
  移動しています。

  ポイントは Sheets("Sheetxx").Move before:=Sheets(n) で、
  目的の位置に移動しています。

  example21 をダウンロードして動作を確認してください。

Sub Sheet_Sort()

    Dim Sheet_Cnt As Integer
    Dim i As Integer
    Dim ThisWorkbook_Name, ThisSheet_Name As String
    Dim TempWorkbook_Name, TempSheet_Name As String
    
    'このWorkbookの名前
    ThisWorkbook_Name = ActiveWorkbook.Name
    
    '現在アクティブになっているシートの名前
    ThisSheet_Name = ActiveSheet.Name
    
    'Sheetの数の取得
    Sheet_Cnt = Sheets.Count
    If Sheet_Cnt = 1 Then
        MsgBox "Sheet が1枚だけなのでソートできません"
        End
    End If
    
    'Sheetの名前を書き出すWorkbookを追加します
    Workbooks.Add
    '追加したBookの名前の取得
    TempWorkbook_Name = ActiveWorkbook.Name
    '追加したSheetの名前の取得
    TempSheet_Name = ActiveSheet.Name
    
    
    For i = 1 To Sheet_Cnt
        'Sheetの名前をセルに順番に代入する
        Range("A" & Format(i)) = _
                            Workbooks(ThisWorkbook_Name).Sheets(i).Name
        
    Next

    '昇順で並べ替える
    Range("A1:A" & Format(EffectiveRow)).Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlPinYin


    'このWorkbookを前面にします
    Windows(ThisWorkbook_Name).Activate

    For i = 1 To Sheet_Cnt
        'ソートしたSheet名で順番にSheetを移動する
        'Sheets("Sheetxx").Move before:=Sheets(n) でSheetを移動します
        Sheets(Workbooks(TempWorkbook_Name).Sheets(TempSheet_Name). _
                      Range("A" & Format(i)).Text).Move before:=Sheets(i)
        
    Next

    '追加したBookを削除(Close)する
    Workbooks(TempWorkbook_Name).Close SaveChanges:=False
    
    'Sheet(1)を選択する
    Sheets(1).Select
    
End Sub

Function EffectiveRow()
'   行の最大数を求める
'   Excelの最大行数(65536)から上方向(xlUp)に向かって空白でないセルを探す
    EffectiveRow = Range("A65536").End(xlUp).Row
End Function