How to change the number of the first element of two-dimensional dynamic array in EXCEL VBA?

EXCEL VBA restricts two-dimensional dynamic array to change the number of element in the last dimension only. Although the constraint, what could you do when you would like to change the first dimension of two-dimensional dynamic array? Please see the code below;

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

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