VBA100本ノック 30本目:名札作成(段組み)

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

名札が二列になっているので、改行することに2進法を使えないか?と
ちょっと考えてみた。今回は、考えてみただけで実装はしていない。

Sub VBA_100Knock_030()
    Dim Ws(ShName.en名簿 To ShName.en名札) As Worksheet
    Set Ws(ShName.en名簿) = Worksheets("名簿")
    Set Ws(ShName.en名札) = Worksheets("名札")
    
    ' 名簿データを一旦配列に格納し、名札用に並び替える。
    Dim SrcArray As Variant
        SrcArray = Range(Ws(ShName.en名簿).Range("B2"), _
            Ws(ShName.en名簿).Range("B2").CurrentRegion. _
                SpecialCells(xlCellTypeLastCell))
                
    Dim DstArray() As Variant
    ReDim DstArray(1 To 2 * WorksheetFunction.RoundUp(UBound(SrcArray) / 2, 0), _
                   1 To 2)
        
    Dim i As Long
    Dim RowIndex As Long
    Dim ColumnIndex As Long
        For i = 1 To UBound(SrcArray)
            RowIndex = 2 * WorksheetFunction.RoundUp(i / 2, 0) - 1
            
            ' データが偶数行か奇数行かで、一列目と二列目を判別する。
            If WorksheetFunction.IsOdd(i) Then
                ColumnIndex = 1
            Else
                ColumnIndex = 2
            End If
            
            DstArray(RowIndex, ColumnIndex) = SrcArray(i, 1)
            DstArray(RowIndex + 1, ColumnIndex) = SrcArray(i, 2)
        Next
        
        Application.ScreenUpdating = False
        
        Ws(ShName.en名札).Range("A1").Resize(UBound(DstArray), 2) = DstArray
        ' 名札の書式コピー&ペースト。
        Ws(ShName.en名札).Rows("1:2").Copy
        Ws(ShName.en名札).Rows("1:" & UBound(DstArray)).PasteSpecial Paste:=xlPasteFormats
        Ws(ShName.en名札).Range("A1").Select
        
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
End Sub

今回も毎度のように、汎用性を持たせようとして、冗長な作りになって
しまった。実行した結果がこちら。

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。