EXCEL VBA で2次元動的配列の第1次元の要素数を変更する

EXCEL VBAでの2次元動的配列には最終次元，つまり第2次元の要素数の変更しかできないという制約があります．しかし現実問題として第1次元の要素数を変更したいという需要はあります．今回は2次元動的配列の第1次元の要素数の変更方法を述べます．下記のコードで2次元配列の全要素を一旦1次元動的配列に書き出し，1次元配列の要素数を増やしてから再度2次元配列に書き戻しています．

Option Explicit
Sub DynamicArray_Sample()
Dim mySht   As Worksheet
Dim myRng   As Range
Dim tmpAr   As Variant
Dim myAr()  As String
Dim myID()  As String
Dim myStr() As String
Dim i       As Long
Set mySht = Worksheets.Add
With mySht
    .Range("A1").Value = "10001"
    .Range("A2").Value = "10002"
    .Range("A3").Value = "10003"
    .Range("A4").Value = "10004"
    .Range("A5").Value = "10005"
    .Range("B1").Value = "aaaaa"
    .Range("B2").Value = "bbbbb"
    .Range("B3").Value = "ccccc"
    .Range("B4").Value = "ddddd"
    .Range("B5").Value = "eeeee"
End With
Set myRng = mySht.UsedRange
tmpAr = myRng
For i = LBound(tmpAr) To UBound(tmpAr)
    ReDim Preserve myID(i)
    ReDim Preserve myStr(i)
    myID(i) = myAr(i, 0)
    myStr(i) = myAr(i, 1)
Next i
ReDim Preserve myID(UBound(myID) + 1)
ReDim Preserve myStr(UBound(myStr) + 1)
myID(UBound(myID)) = "10006"
myStr(UBound(myStr)) = "fffff"
ReDim myAr(UBound(myID), 1)
For i = LBound(myAr) To UBound(myAr)
    myAr(i, 0) = myID(i)
    myAr(i, 1) = myStr(i)
Next i
Set mySht = Worksheets.Add
With mySht
    .Range("A1:B6") = myAr
End With
Set mySht = Nothing
End Sub