複数の離れた選択範囲をコピーペースト

エクセルでCtrlを押しながら複数の離れたセルを選択しています。
それを指定したセルに縦1列に並べる方法はありますか？（Sheet2のA1から下方向へ並べる）
順番が入れ替わっても問題ありません。

普通に行うと複数の選択範囲に対して実行できません。という警告が出ます。

他の方のよく似た質問の回答でVBAが見つかりましたが、その回答では選択したセルの位置関係をキープしたままの状態で貼り付けされるので、縦１列に並べるように改良して欲しいです？
宜しくお願いします。

Sub sample()
On Error Resume Next
Set base = Application.InputBox("コピー先セルを入力してください。", Type:=8)
If base Is Nothing Then Exit Sub
For Each a In Selection
If b = "" Then b = a.Row: c = a.Column
base.Offset(a.Row - b, a.Column - c) = a.Value
Next
End Sub

No.1 ベストアンサー 回答者： keithin 回答日時： 2012/10/20 12:15

こんにちは。

＞複数の選択範囲に対して実行できません。という警告が出ます。
　
「順番が入れ替わっても問題ありません。」ということならお話はとても簡単で、１つずつコピー貼り付けていくだけです。

sub macro1()
　dim i as long
　dim h as range
　i = 1
　worksheets("Sheet2").range("A:A").clear

　for each h in selection
　　h.copy worksheets("Sheet2").cells(i, "A")
　　i = i + 1
　next
end sub

この回答へのお礼

回答ありがとうございます。
バッチリできました！助かります。

お礼日時：2012/10/20 12:39