>>909
何もかも違ってる気がするので丸ごと作り直してみたけど、これで希望の結果になってるかはわからない

Sub CustomSort()
　　Dim LastRow As Long
　　Dim SortRange As Range
　　Dim SortKeyRange As Range
　　Dim i As Long

　　With ActiveWorkbook.ActiveSheet
　　　　LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
　　　　Set SortRange = .Range("A2:B" & LastRow)
　　　　Set SortKeyRange = .Range("B2:B" & LastRow)
　　　　.Range("A2:A" & LastRow).Copy Destination:=SortKeyRange
　　　　For i = 2 To LastRow
　　　　　　If Left(.Cells(i, 1), 1) Like "[〇☆]" Then
　　　　　　　　.Cells(i, 2) = Mid(.Cells(i, 1), 2, 1)
　　　　　　End If
　　　　Next i

　　　　With .Sort
　　　　　　.SortFields.Clear
　　　　　　.SortFields.Add2 Key:=SortKeyRange
　　　　　　.SetRange SortRange
　　　　　　.Header = xlNo
　　　　　　.MatchCase = False
　　　　　　.Orientation = xlTopToBottom
　　　　　　.SortMethod = xlPinYin
　　　　　　.Apply
　　　　End With
　　End With
End Sub