这是我所能想象的最简单的办法：
创建包含以下公式的帮助器列：

=MATCH(B2,B$2:B$6,0)

......然后使用该列进行排序。
这是启动时的外观：

这是使用新列排序后的结果：

（显然，值已经改变，但这不会改变情况的行为。）

组数据

Sub GroupData()
    
    ' Define constants.
    
    Const GroupColumn As Long = 2
    
    ' Reference the range.
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim rg As Range, rCount As Long, cCount As Long
    
    With ws.Range("A1").CurrentRegion
        rCount = .Rows.Count - 1 ' exclude headers
        If rCount < 2 Then
            MsgBox "Nothing to group.", vbExclamation
            Exit Sub
        End If
        cCount = .Columns.Count
        If cCount < GroupColumn Then
            MsgBox "Need more columns.", vbExclamation
            Exit Sub
        End If
        Set rg = .Resize(rCount).Offset(1)
    End With
    
    ' Write the values from the range to an array, the Source array.
    
    Dim sData() As Variant: sData = rg.Value
    
    ' Write each unique value from the Group column of the Source array
    ' to the 'key' of a dictionary, and the associated row number(s)
    ' to the collection held by each associated 'item'.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim r As Long, rString As String
    
    For r = 1 To rCount
        rString = CStr(sData(r, 2))
        If Not dict.Exists(rString) Then Set dict(rString) = New Collection
        dict(rString).Add r
    Next r
    
    ' Using the information in the dictionary, write the values from
    ' the Source array grouped to the (same-sized) Destination array.
    
    Dim dData() As Variant: ReDim dData(1 To rCount, 1 To cCount)
    
    Dim rKey As Variant, rItem As Variant, c As Long
    
    r = 0
    
    For Each rKey In dict.Keys
        For Each rItem In dict(rKey)
            r = r + 1
            For c = 1 To cCount
                dData(r, c) = sData(rItem, c)
            Next c
        Next rItem
    Next rKey
    
    ' Write the values from the Destination array to the range.
    
    rg.Value = dData
        
End Sub