Sub test()
Dim lastCell As Range
Dim area As Range
Dim pos As Long
Set lastCell = Cells(Rows.Count, "A").End(xlUp)
pos = 1
For Each area In Range("A1", lastCell).SpecialCells(xlCellTypeConstants).Areas
area.Copy
Cells(pos, "C").PasteSpecial Paste:=xlPasteAll, Transpose:=True
pos = pos + 1
Next
Application.CutCopyMode = False
End Subポイントは、
行と列を入れ替えての貼付です。これは手作業でも出てきます、マクロ記録でコードが
わかります。
あとは、まとまった単位でコピーするところです。
これは、色々な方法があると思いますが、
Areasプロパティ（連結領域毎に分離したAreasコレクションを返します）を利用する方法を
使ってみました。内容を確認して下さい。
確認の便宜のため、あえて、C列にコピーしています。
必要に応じて修正してください。
（私は確認未済と断らない限り、実際に動作することを確認して投稿しています）
余談：高円寺には好きな喜多方ラーメン店があります。最近ご無沙汰です。
