エクセル最終行の下に貼り付け

VBAで以下の作業を教えて下さい。

Sheet1のB列に入力済みのセルが何行かあります。
その入力済みのセルの値をコピーして、Sheet2のA列の入力済みの最終行のすぐ下の行に貼り付ける。

＊Sheet1のB列の入力済みのセルの行数は毎回変わります。
＊Sheet２のA列には一番最初は何も入力されていない状態です。

宜しくお願い致します。

No.2 ベストアンサー 回答者： tom04 回答日時： 2011/08/30 23:30

No.1です！

補足を読ませていただきました。

Sheet1のB・C列をSheet2のA・B列の最終行以降に！ということなので・・・

おそらくSheet1のB・C列の行数（データ量）が違うのが普通だと思いますので、
2列を範囲指定　→　Sheet2のA列もしくはB列の最終行以降に貼り付け！という操作では
空白セルが出来てしまうと思います。
もちろんそれを削除するコードを作れば良いのですが、今回は2列だけだというコトですので
単純に前回の操作を2回繰り返すコードにしてみました。

Sub test2()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
i = ws1.Cells(Rows.Count, 2).End(xlUp).Row
j = ws1.Cells(Rows.Count, 3).End(xlUp).Row
Range(ws1.Cells(2, 2), ws1.Cells(i, 2)).Copy
ws2.Activate
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Range(ws1.Cells(2, 3), ws1.Cells(j, 3)).Copy
ws2.Activate
ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End Sub

こんな感じではどうでしょうか？

※　じっくり考えればもっと良い方法があるかもしれません。
この程度でごめんなさいね。m(_ _)m

この回答へのお礼

何度もありがとうございました。
すべて解決しました、助かりました。

お礼日時：2011/08/30 23:36

No.1 回答者： tom04 回答日時： 2011/08/30 22:48

こんばんは！

Sheet1・Sheet2ともに1行目は項目行でデータは2行目以降にあるとします。
一例です。標準モジュールにコピー＆ペーストしてマクロを試してみてください。

Sub test()
Dim i As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1") '←Sheet名（sheet1の部分）は実際のSheet名に！
Set ws2 = Worksheets("sheet2") '←こちらのSheet名も実際のSheet名に！
i = ws1.Cells(Rows.Count, 2).End(xlUp).Row
Range(ws1.Cells(2, 2), ws1.Cells(i, 2)).Copy
'↑Sheet1の1行目から場合は「ws1.Cells(2, 2)」を「ws1.Cells(1, 2)」に！
ws2.Activate
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答への補足

ありがとうございます。
バッチリできました。
因みにSheet1のB列だけじゃなくB列とC列の両方をコピーして、
Sheet２のA列とB列に同じように貼り付けの場合なら、どこを変化させたら良いのですか？

補足日時：2011/08/30 23:00