Function DictToSortedArray(D As Object) As Variant
    'returns a 1-based 2-dimensional sorted array
    'sorted by the keys
    Dim A As Variant, i As Long, AL As Object, k As Variant

    Set AL = CreateObject("System.Collections.ArrayList")

    For Each k In D
        AL.Add k
    Next k

    AL.Sort

    ReDim A(1 To AL.Count, 1 To 2)

    For i = 1 To AL.Count
        A(i, 1) = AL(i - 1)
        A(i, 2) = D(AL(i - 1))
    Next i

    DictToSortedArray = A
End Function

Sub test()
    Dim D As Object
    Dim A As Variant
    Dim i As Long

    Set D = CreateObject("Scripting.Dictionary")
    D.Add 5, 8
    D.Add 3, 7
    D.Add 42, 9
    D.Add 1, 7
    D.Add 10, 11

    A = DictToSortedArray(D)
    For i = 1 To 5
        Debug.Print A(i, 1) & ", " & A(i, 2)
    Next i
End Sub

1, 7
3, 7
5, 8
10, 11
42, 9

Sub Tester()

    Dim d As Object
    Dim i As Long, arr, k

    Set d = CreateObject("scripting.dictionary")


    With d
        .Add 3, 33
        .Add 1, 33
        .Add 2, 55
        .Add 5, 77
    End With

    arr = d.keys  '<< get keys in an array

    ' "sort" through the array, and get the values from the dictionary
    Debug.Print "key", "value"
    For i = 0 To UBound(arr)
        k = Application.Small(arr, i + 1)
        Debug.Print k, d(k)
    Next i

End Sub

key          value
  1             33
  2             55
  3             33
  5             77

Option Explicit

Sub sortedDictionary()
    Dim i As Long, j As Long, d As Long, dict As Object
    Dim vKEYs As Variant, tmp As Variant

    Set dict = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet4")
        For d = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            dict.Item(.Cells(d, "A").Value2) = .Cells(d, "B").Value2
        Next d

        vKEYs = dict.keys

        For i = LBound(vKEYs) + 1 To UBound(vKEYs)
            For j = LBound(vKEYs) To UBound(vKEYs) - 1
                If vKEYs(j) > vKEYs(i) Then
                    tmp = vKEYs(j)
                    vKEYs(j) = vKEYs(i)
                    vKEYs(i) = tmp
                End If
            Next j
        Next i

        ReDim tmp(1 To UBound(vKEYs) + 1, 1 To 2)

        For i = LBound(vKEYs) To UBound(vKEYs)
            tmp(i + 1, 1) = vKEYs(i)
            tmp(i + 1, 2) = dict.Item(vKEYs(i))
        Next i

        .Cells(2, "E").Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
    End With
End Sub

Sub SortDictionary(dict As Object)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add key, dict(key)
        Next
        dict.RemoveAll
        For i = 0 To .Keys.Count - 1
            dict.Add .GetKey(i), .Item(.GetKey(i))
        Next
    End With
End Sub

SortDictionary dict '<--| give 'SortDictionary()' sub a dictionary object to sort by its keys

Sub main()

    Dim dict As Object
    Dim key As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add 5, 15
        .Add 4, 14
        .Add 3, 13
        .Add 2, 12
        .Add 1, 11
    End With

    SortDictionary dict

    With dict
        For Each key In .Keys
            Debug.Print key, .Item(key)
        Next
    End With
End Sub