VBA、SORTメソッドの優先キーが反映されない

前提・実現したいこと

VBAで１つのシート内で複数回に分けて、２つのキーを用いた並び替えを実行しようとしています。
表１と２はナンバリングを昇順、評価点を降順に（こちらが最優先のキーです）、
残りの表３～５はナンバリングを昇順とするキーを用います。

発生している問題・エラーメッセージ

実行したところ、ナンバリングを昇順にする並び替えは反映されている一方、
表１と２において最優先の評価点を降順にする並び替えが実行されていません。

該当のソースコード

VBA
ソースコード
Sub 貼り付け用シートに転記()

Application.ScreenUpdating = False

EndRow = Range("A3").End(xlDown).Row
Dim i As Integer, j As Integer
Dim pN As Integer
Dim wsFrom As Worksheet, wsTo As Worksheet
Set wsFrom = Worksheets("入力フォーム")
Set wsTo = Worksheets("WORD転記用")
Dim str As String
Dim sot As Sort
Dim indexAr2() As Variant, iArr() As Variant
indexAr2() = Array("F", "G", "H")
iArr() = Array("B", "D", "E", "G", "H", "I", "K", "L", "N", "O")
fromCount = wsFrom.Range("A3").End(xlDown).Row


wsTo.Activate

For i = 0 To (fromCount - 3)
    
    If wsFrom.Range("C3").Offset(i).Value <> "" Then
        wsFrom.Cells(3 + i, 1).Copy
        wsTo.Range("B3").Offset(i).PasteSpecial Paste:=xlPasteValues
        wsTo.Range("C3").Offset(i).Formula = _
        "=Concatenate(""評価"", 入力フォーム!B" & (3 + i) & _
        ", "":"", vlookup(B" & (3 + i) & ", 入力フォーム!$A$2:$E$" & fromCount & ", 3))"
        wsTo.Range("D3").Offset(i).Value = wsFrom.Range("B3").Offset(i).Value
    End If
    
    If wsFrom.Range("E3").Offset(i).Value <> "" Then
        wsFrom.Cells(3 + i, 1).Copy
        wsTo.Range("E3").Offset(i).PasteSpecial Paste:=xlPasteValues
         wsTo.Range("F3").Offset(i).Formula = _
        "=Concatenate(""評価"", 入力フォーム!D" & (3 + i) & _
        ", "":"", vlookup(E" & (3 + i) & ", 入力フォーム!$A$2:$E$" & fromCount & ", 5))"
        wsTo.Range("G3").Offset(i).Value = wsFrom.Range("D3").Offset(i).Value
    End If
    
    
    For j = 0 To 2
    
        If wsFrom.Range(indexAr2(j) & 3).Offset(i).Value <> "" Then
            wsFrom.Cells(3 + i, 1).Copy
            wsTo.Range(indexAr2(j) & 3).Offset(i, 2 + (j * 2)).PasteSpecial Paste:=xlPasteValues
            wsTo.Range(indexAr2(j) & 3).Offset(i, 3 + (j * 2)).Formula = _
            "=concat(""・"", 入力フォーム!" & indexAr2(j) & (3 + i) & ")"
        End If
        
    Next j
Next i

With ThisWorkbook.Worksheets("WORD転記用")

For j = 0 To 8 Step 2

.Range(iArr(j) & 2 & ":" & iArr(j + 1) & fromCount).Sort _
    key1:=Range(iArr(j) & 2), Order1:=xlAscending, _
    key2:=Range(iArr(j + 1) & 2), Order2:=xlDescending, _
    Header:=xlYes
    
Next j

End With

Application.ScreenUpdating = True

End Sub

試したこと

以下のように、SortFieldsを用いた書き方に変更した結果も同様でした。

Set sot = ActiveWorkbook.Worksheets("WORD転記用").Sort

With sot

    For j = 0 To 8 Step 2

    With .SortFields
        .Clear
        .Add Key:=Range(iArr(j) & 2), _
                        Order:=xlAscending

        .Add Key:=Range(iArr(j + 1) & 2), _
                        Order:=xlDescending



    End With

    .SetRange Range(iArr(j) & 2 & ":" & iArr(j + 1) & fromCount)
    .Header = xlYes
    .Apply

    If j <= 1 Then
        wsTo.Columns(iArr(j + 1)).Clear
    End If


    Next j