Sheet2にある情報をSheet1のA1に１列で

質問

マクロを作りたいのですが、以下のようなものをどうすればできるかで詰まっています。

Sheet2にある情報をSheet1のA1に１列（A列B列C列の順）で並ぶようにしたいです。
Sheet2の内容は変わることがあるので、データがどの行まで入っているかはマクロを走らせるときにチェックしないとわからないかと思います。

[Sheet1]

111
222
333
aa
bb
aaa
bbb
ccc
ddd
eee

--------------------------
[Sheet2]

A B C
1 111 aa aaa
2 222 bb bbb
3 333 ccc
4 ddd
5 eee

素人な質問かもしれないですが、調べてもわからなかったので、教えていただけると幸いです。

回答No.4

keithin · ベストアンサー

＞A列　F列　H列にあるデータのみ

他の方への投げかけでは，また違う場所にあるデータを転記したいとなっていますよね。
「具体的に」どこからのデータを転記したいのかによって，適切なマクロの書きぶりが違うということを理解してください。

○Ａ列，Ｃ列，Ｅ列，Ｇ列のように規則的に飛び飛びの列を処理したいと言いたかったときは
sub macro2()
　dim i as long
　dim r as long
　worksheets("Sheet1").range("A:A").clearcontents
　for i = 1 to 7 step 2
　r = worksheets("Sheet2").cells(65536, i).end(xlup).row
　worksheets("Sheet2").cells(1, i).resize(r, 1).copy _
　　destination:=worksheets("Sheet1").range("A65536").end(xlup).offset(1)
　next i
　worksheets("Sheet1").range("A1").delete shift:=xlshiftup
end sub

○通常はあまり考えにくい状況ですが，Ａ列，Ｆ列，Ｈ列とデタラメな列を処理したい場合
sub macro3()
　dim i as variant
　dim r as long
　dim a as variant
　a = array(1,6,8)
　worksheets("Sheet1").range("A:A").clearcontents
　for each i in a
　r = worksheets("Sheet2").cells(65536, i).end(xlup).row
　worksheets("Sheet2").cells(1, i).resize(r, 1).copy _
　　destination:=worksheets("Sheet1").range("A65536").end(xlup).offset(1)
　next i
　worksheets("Sheet1").range("A1").delete shift:=xlshiftup
end sub

＃補足
思いつきで補足質問を投げるから，言葉足らず説明不足で「良いアドバイス」が得られません。結果してお互いに二度手間三度手間になることが非常に多くあります。まさにこのご相談のように。
次の課題に進みたい時は思いつきで「ついでに聞いちゃえ」じゃなく，一回ご相談を「解決」で閉じてから，改めて「今度は具体的にこういう状況でこうしたい」とキチンとご相談を書くことを覚えてください。

お礼

とてもわかりやすく、理解できました。ありがとうございます。

今後質問するときは気お付けます。

回答No.3

kigoshi

Sheet2はA,B,Cの３列のみなのでしょうか？
もしそれ以降もある可能性があるのなら

Sub sample()
Dim rIdx, rIdx1, cIdx As Long
Sheets("Sheet2").Activate
Do Until Cells(1, cIdx + 1).Value = ""
cIdx = cIdx + 1
For rIdx = 1 To Cells(Rows.Count, cIdx).End(xlUp).Row
rIdx1 = rIdx1 + 1
Sheets("Sheet1").Cells(rIdx1, 1).Value = Cells(rIdx, cIdx).Value
Next
Loop
End Sub

ではいかがでしょう？

補足

ありがとうございます！

すいません、言葉が足りなかったのですが、
連続した列ではなく、

A、C、F、H、J
というように列を指定したいです。どう書き換えればいいでしょうか？

回答No.2

mu2011

一例です。

Sub sample()
Set st1 = Sheets("sheet1")
Set st2 = Sheets("sheet2")
For c = 1 To 3
For r = 1 To st2.Cells(Rows.Count, c).End(xlUp).Row
cnt = cnt + 1
st1.Cells(cnt, "A") = st2.Cells(r, c)
Next
Next
End Sub

補足

ありがとうございます！
しかし列をつないだときに、間に空白行が１行入ってしまうようです、、

回答No.1

keithin

こんなカンジ：
sub macro1()
　dim i as long
　dim r as long
　worksheets("Sheet1").range("A:A").clearcontents
　for i = 1 to 3
　r = worksheets("Sheet2").cells(65536, i).end(xlup).row
　worksheets("Sheet2").cells(1, i).resize(r, 1).copy _
　　destination:=worksheets("Sheet1").range("A65536").end(xlup).offset(1)
　next i
　worksheets("Sheet1").range("A1").delete shift:=xlshiftup

end sub

補足

ありがとうございます！

ちなみになのですが、
A列　F列　H列
にあるデータのみこのマクロを適用させてシート１にコピーしたい場合はどのように記述すればいいのでしょうか？？