A列にある空白間の文字列をB列に列行入れ替えコピーを文字列が無くなるまで行いたい。

データ量が多すぎてマクロを考えていますが、うまくいきません。
誰かご教示をお願いいたします。
空白をはさんでA列に文字列が40000行ほどあるのですが、空白から空白までの行をコピーし
行列入替てB列にペーストしたいのですが、うまくいきません。
結果として縦のデータを横にして一覧にしたいのですが、空白から空白まで文字列をうまく処理できません。
イメージとしては以下のようにしたいのですが。。。
A列　　B列　C列　D列　
A1空白　1 2　　3
A2　1 　4 5 6　
A3　2
A4　3
A5空白
A6　4
A7　5
A8　6
A9空白
以下続く

空白は必ず１行ですが、文字列は規則性はなく複数行になります。
また、A列は特に残す必要はありません。
このような説明で申し訳ありませんがだれかご教授いただけると助かります。
宜しくお願い致します。

No.1 ベストアンサー 回答者： GooUserラック 回答日時： 2017/11/23 19:02

こんな事でしょうか？

--------------------------------------------------------------------------------
Sub Sample()
Dim 元行 As Long
Dim 先行 As Long
Dim 先列 As Long
For 元行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(元行, 1).Value = "" Then
先行 = 先行 + 1
先列 = 2
Else
Cells(先行, 先列).Value = Cells(元行, 1).Value
先列 = 先列 + 1
End If
Next
End Sub
--------------------------------------------------------------------------------

この回答へのお礼

助かりました。
ありがとうございます。

お礼日時：2017/11/24 20:52

No.2 回答者： mike_g 回答日時： 2017/11/23 20:17

添付図参照

１．次式を入力したセル F1 を下方にズズーッとオートフィル
￣￣ =INDEX(A:A,SMALL(IF(A:A<>"",ROW(A:A),""),ROW(A1)))
￣￣ 【お断り】上式は必ず配列数式として入力のこと
２．次式を入力したセル B1 を右に３列、かつ、下方にズズーッとオートフィル
￣￣ =IFERROR(OFFSET($F$1,(ROW(A1)-1)*3+MOD(COLUMN(A1)-1,3),),"")

この回答へのお礼

ありがとうございます。

お礼日時：2017/11/24 21:05