VBA 4行毎にセルをコピペする方法をご教授お願いします＞＜

質問

VBA 4行毎にセルをコピペする方法をご教授お願いします＞＜

はじめましてVBA初心者です。
質問のマクロをForNext等で作成しましたが行毎にコピペする方法が導きませんでしたのでどなたかご教授のほどお願いします。

■やりたいこと
Sheet1のA1～A50のセル行をコピーし、Sheet4のA1を開始としてA1、A5、A9・・・と貼り付け
Sheet2のA1～A50のセル行をコピーし、Sheet4のA2を開始としてA2、A6、A10・・・と貼り付け
Sheet3のA1～A50のセル行をコピーし、Sheet4のA3を開始としてA3、A7、A11・・・と貼り付け
を行いたい。

■イメージ
　 Sheet1 Sheet2 Sheet3 Sheet4
A(列) A(列) A(列) A(列)
1 Name1 1 com1 1 Address1 1 Name1
2 Name2 2 com2 2 Address2 2 com1
3 Name3 3 com3 3 Address3 3 Address1
4 Name4 4 com4 4 Address4 4 Name2
5 Name5 5 com5 5 Address5 5 com2
6 Name6 6 com6 6 Address6 6 Address2
7 Name7 7 com7 7 Address7 7 Name3
8 Name8 8 com8 8 Address8 8 com3
9 Name9 9 com9 9 Address9 9 Address3
10 Name10 10 com10 10 Address10 :
: : : :
■作成途中のマクロ
Sub　Sample（）
Dim rw1 As Integer 'Sheet1の変数
Dim rw2 As Integer 'Sheet2の変数

With Sheets("Sheet1")
For rw1 = 1 To 50
Sheets("Sheet1").Cells(rw1, 1).Copy
？？？Sheets("Sheet2").Cells(rw1 * 4 , 1).PasteSpecial Paste:=xlPasteValues
Next rw1

ForNextの組み合わせ+αで自動化できる方法があれば教えてください。
わかりづらい御説明で申し訳ございませんがお願い致します。

回答No.1

chamiken · ベストアンサー

完全なる独学のため、質問者様の使われている関数もよく知りませんが、
質問者様のマクロを参考にした以下のマクロで、ご希望の結果は得られます。

たぶんForの中にForを入れて繰り返しをなくせるんだろうなぁとは思いますが、
試しに実行したら一瞬でデータの貼付は完了しましたので、これ以上短くする努力をやめました(笑)

Sub Macro1()
Dim a
For a = 1 To 50
Sheets("Sheet1").Cells(a, 1).Copy
Sheets("Sheet4").Cells(3 * a - 2, 1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet2").Cells(a, 1).Copy
Sheets("Sheet4").Cells(3 * a - 1, 1).PasteSpecial Paste:=xlPasteValues
Sheets("Sheet3").Cells(a, 1).Copy
Sheets("Sheet4").Cells(3 * a, 1).PasteSpecial Paste:=xlPasteValues
Next
End Sub

お礼

chamikenさん
返信が遅れまして申し訳ございません。
早速試してみました！
思い通りの結果となり感謝!^^!感激!^^!です。
やっと眠れます^^;有難う御座います^^
ForNextの基本は理解したつもりでしたが、やはりまだまだ応用が利きませんでした^^;
この構文を導きさせるようこれからも頑張ります。

chamikenさん本当にありがとうございましたアリガト━((≧Д≦*爻≧∀≦*))━!!!!
またよろしくお願いします^^;