ExcelのVBAで最終行の下にコピーする方法

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1：D6のうちピンクの部分を、横一列に並べ替えながら、
F1：M6の色つきの部分（実際はより横に広くなります）に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の表から同じように転記する場合、
どうコード変わるかも教えていただけましたら助かります。

自分では、下記のようなコードしか書けませんでした。
転記先の表は30列程度になる予定ですので、
出来ればシンプルなコードを教えていただきたいです。


Sub コピー()

Range("B2").Select
Selection.Copy
Range("G2").End(xlUp).Offset(1).Select
ActiveSheet.Paste

End sub


分かりづらい説明かと思いますが、
よろしくお願いします。

No.1 ベストアンサー 回答者： keithin 回答日時： 2013/08/19 23:23

その程度の転写なら、あんまりカッコつけてやろうとせずに１個ずつ順番に転記してった方が、シンプルで間違いもありません。

sub macro1()
　dim h as range
　dim c as long
　dim LastRow as long

’貼り付け先行
　lastrow = worksheets("Sheet2").range("G65536").end(xlup).offset(1).row
’貼り付け先列
　c = 7　’Ｇ列

　for each h in worksheets("Sheet1").range("B2:D6")　’コピー元
　　worksheets("Sheet2").cells(lastrow, c).value = h.value
　　c = c + 1　’右の列に
　next
end sub

この回答へのお礼

ご回答ありがとうございました。
どのコードが何のためのものか説明していただき、
大変勉強になりましたのでベストアンサーにさせていただきます。

皆様のご回答を参考に、
自分で調節しながら思い通りに表を作成することが出来ました。

お礼日時：2013/08/20 22:31

No.3 回答者： NYAFRAC 回答日時： 2013/08/20 08:01

bouheur様

　おはようございます。

こんな例もいかがですか？

Option Explicit

Sub 転記()
Dim row1 As Long
Dim row2 As Long

If Cells(2, 7) <> "" Then
row2 = Cells(1, 7).End(xlDown).row + 1
Else
row2 = 2
End If

For row1 = 2 To 6
Range(Cells(row1, 2), Cells(row1, 4)).Copy Destination:=Cells(row2, 3 * row1 + 1)
Next row1

End Sub

この回答へのお礼

ご回答ありがとうございます。
IFの使用は思いつかなかったため、大変参考になりました。

お礼日時：2013/08/20 22:29

No.2 回答者： tom04 回答日時： 2013/08/19 23:45

こんばんは！

一例です。

↓の画像のように上側がSheet1で下側のSheet2にコピー＆ペーストするようにしています。
尚、Sheet1は画像通りに規則正しく、3列のデータとします。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, endRow As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
endRow = wS2.Cells(Rows.Count, "B").End(xlUp).Row + 1
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
wS1.Cells(i, "B").Resize(, 3).Copy wS2.Cells(endRow, 3 * (i - 1) - 1)
Next i
End Sub

こんな感じではどうでしょうか？m（_ _）m

この回答へのお礼

御回答ありがとうございます。
複数の方法があるようで、大変勉強になりました。

お礼日時：2013/08/20 22:28