VBA AZ 排序无法正常工作

Question

希望你能帮上忙。 我有一段代码打开一个对话框，然后允许用户选择另一个 Excel 工作表，然后一旦选择了该 Excel 工作表，就会调用另一段代码，并按字母顺序对 B 列进行排序。

我遇到的问题是 VBA 代码没有正确进行排序

如果我通过单击 AZ 排序按钮手动对列进行排序，我会在图 1 中得到结果

图 1

但是当我运行代码以按字母顺序对 B 列进行排序时。我在图 2 中得到结果

图 2

如您所见，顶部条目不正确，Anne Mette Toftager 没有正确排序，第二个条目仍然在第 83 行的工作表下方

我的代码如下。可以修改我的代码以使排序正常工作并且结果与图 1 中的结果相同吗？

一如既往地非常感谢任何帮助。

PS 我应该指出，VBA 排序还必须“扩展选择”

我的代码

Sub Open_Workbook_Dialog()

Dim my_FileName As Variant

    MsgBox "Select Denmark File" '<--| txt box for prompt to pick a file

        my_FileName = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*") '<--| Opens the file window to allow selection

    If my_FileName <> False Then
    Workbooks.Open Filename:=my_FileName


Call SortColumn     '<--|Calls the Filter Code and executes

End If


End Sub

Public Sub SortColumn()
    With ActiveWorkbook.Sheets(1)

    .Unprotect
    lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    .Range("A1").Resize(79, lastcol).Sort Key1:=Range("B1"), _
    Order1:=xlAscending, _
    Header:=xlGuess, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
End With
End Sub

Answer 1

这应该可以工作

Sub SortColumn()

    With ActiveWorkbook.Sheets(1)

        Dim LastRow As Long
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Dim LastCol As Long
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range(Cells(2, 2), Cells(LastRow, 2)), _
                            SortOn:=xlSortOnValues, _
                            Order:=xlAscending, _
                            DataOption:=xlSortNormal
            .SetRange Range(Cells(2, 1), Cells(LastRow, LastCol))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply

        End With

    End With
End Sub