>>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