フリガナで並べ替え（フリガナが入ってなければ自動読みで挿入）

    Dim セル As Range
    Dim 選択範囲 As Variant

    '(1)フリガナが入ってなければ自動読みで挿入
    For Each セル In 選択範囲
        If VarType(セル) = vbString Then
            If セル.Characters.PhoneticCharacters = "" Then
                セル.SetPhonetic
            End If
        End If
    Next セル
     
    '(2)一覧をフリガナで並べ替え
    選択範囲.Sort Key1:=選択範囲(1), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
    :=xlPinYin, DataOption1:=xlSortNormal

    '自動読みのフリガナの不具合はフリガナの修正をおこなう（2回目以降はそのフリガナで並ぶ）