複数の行を単一の列に転置する方法

私はExcelシートを持っています

A 1234
  1234
  1234 
  1234
B 12
  12

等々

シートを取得する必要があります

A 1234 1234 1234 1234
B 12 12

示されているようにデータを再配置するVBAマクロを次に示します

アクティブシートを処理し、1）データがセルA1から始まる、2）行または列にギャップがない、3）シートに他のデータがない、4）データが値（式ではない）、 5）フォーマットを保持する必要はありません。

Sub OneColumn()
    Dim rng As Range
    Dim vSrc As Variant
    Dim vDst As Variant
    Dim cl As Range
    Dim ws As Worksheet
    Dim rwSrc As Long, rwDst As Long
    Dim i As Long

    Set ws = ActiveSheet
    ' find the right most used column
    Set cl = ws.UsedRange.Find("*", [A1], xlValues, , xlByColumns, xlPrevious)

    ' in case there is no data on the sheet    
    If Not cl Is Nothing Then
        ' get a range bounding the data
        Set rng = Range(ws.[A1], ws.[A1].End(xlDown).Offset(, cl.Column - 1))

        ' copy source data to an array
        vSrc = rng

        ' size another array large enough (too large) to hold destination data  
        '   (note: vDst is transposed to allow for later redim preserve)
        ReDim vDst(1 To 2, 1 To UBound(vSrc, 1) * (UBound(vSrc, 2) - 1))

        ' loop through the source data, copying to the destination array
        rwDst = 1
        For rwSrc = 1 To UBound(vSrc, 1)
            vDst(1, rwDst) = vSrc(rwSrc, 1)
            For i = 2 To UBound(vSrc, 2)
                If vSrc(rwSrc, i) <> "" Then
                    vDst(2, rwDst + i - 2) = vSrc(rwSrc, i)
                Else
                    Exit For
                End If
            Next
            rwDst = rwDst + i - 2
        Next

        ' discard excess size from destination array
        ReDim Preserve vDst(1 To 2, 1 To rwDst)

        ' clear old data from sheet
        rng.Clear
        ' put result on sheet
        [A1].Resize(UBound(vDst, 2), 2) = Application.Transpose(vDst)
    End If
End Sub