VBA 別シートにコピペ後値クリア（パート２）

お世話になります。同じような質問をさせていただいて間もないのですが、またしてもわからないことがありますので質問させていただきます。
エクセルにてコマンドボタン（SHEET1上に配置）をクリックすることで下記を実行するにはどうしたら良いですか。

(1)；SHEET1のB12:I23に入力した値をSHEET2のB4:I15に貼り付けを行い、その後にSHEET1のB12:I23を空白に戻す。

(2)；(1)を実行後、再度SHEET1のB12:I23に値を入力を行い、同じコマンドボタンをクリックすると、今度は(1)で貼り付けたSHEET2のB4:I15の下に改行して貼り付ける。ただし、前回貼り付けられたSHEET2のB列の最終行の下に空白のセルをつくりたくないです。
例えば、(1)を実行したときにSHEET1のB15の行までしか入力が無かった場合は、(2)を実行しSHEET2にコピペするのはB7の行からということです。
あとはこの作業のくりかえし

説明ベタで申し訳ありませんが、SHEET1で入力する際は、全ての行（B12:B23）が埋まるわけではないのです。
SHEET2はSHEET1に入力した値を記録として残しておくために設けるので空白セルを作りたくないのです。どうか宜しくお願いします。

No.1 回答者： n-jun 回答日時： 2009/04/07 10:50

シート１のＢ２３以下にデータがなければ、

Dim r2 As Range

Set r2 = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp)
If r2.Row < 4 Then Set r2 = Worksheets("Sheet2").Range("B4")

With Worksheets("Sheet1")
　　With .Range(.Range("B12"), .Cells(Rows.Count, 2).End(xlUp)).Resize(, 8)
　　　　.Copy r2
　　　　.ClearContents
　　End With
End With

Set r2 = Nothing

こんなとか？

この回答へのお礼

ご回答ありがとうございます。
わからないことばかりなので、内容をしっかり把握することから
始めてみたいとおもいます。

お礼日時：2009/04/08 09:03

No.2 ベストアンサー 回答者： merlionXX 回答日時： 2009/04/07 11:24

前回回答したmerlionXXです。

これでどうでしょう？

Sub test02()
Dim x As Long, xx As Long
Dim Rng As Range
x = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
xx = Application.Max(Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row, 4)

If x < 12 Then
MsgBox "表B列にデータがありません。", vbCritical, "Σ（￣ロ￣lll)"
Exit Sub
End If
Set Rng = Sheets("Sheet1").Range("B12:I" & x)
Rng.Copy Sheets("Sheet2").Range("B" & xx + 2)
Rng.ClearContents
Set Rng = Nothing
End Sub

この回答への補足

ご回答いただいたプログラムを実行すると、先に貼り付けられた値と次に貼り付けられる値の間に１行空白の行が出来てしまうんですが、それを無くすにはどこを直せばよろしいですか？
大変申し訳ないですが、ご教授いただければ幸いです。
宜しくお願いします。

補足日時：2009/04/08 10:44

この回答へのお礼

前回に引き続きのご回答ありがとうございます。
こちらのお願い以上のプログラムとは恐れ入ります。ただ・・・、仕事での使用を想定してますので、『"Σ（￣ロ￣lll)"』だけは・・・使えません↓
その点だけは変更させていただきます！ごめんなさい。
この度は本当にお世話になりました。ありがとうございました。

お礼日時：2009/04/08 09:13

No.3 回答者： merlionXX 回答日時： 2009/04/08 17:18

> 先に貼り付けられた値と次に貼り付けられる値の間に１行空白の行が出来てしまうんですが

入力した値を記録として残しておくためには１行あかないとどこまでが一回分なのかわからなくなりますが、それでもいいのなら

Sub test03()
Dim x As Long, xx As Long '変数宣言
Dim Rng As Range
x = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row 'Sheet1B列最終行取得しxとする
xx = Application.Max(Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row, 4) 'Sheet2B列最終行取得しxxとする
If x < 12 Then 'xが12未満なら
MsgBox "表B列にデータがありません。", vbCritical
Exit Sub 'マクロ中止
End If
Set Rng = Sheets("Sheet1").Range("B12:I" & x) 'Sheet1のデータ範囲をRngとする
Rng.Copy Sheets("Sheet2").Range("B" & xx + 1) 'コピーペースト（ここを修正しました。）
Rng.ClearContents 'Rngをクリア
Set Rng = Nothing '後処理
End Sub

それぞれのコードが何をしているのかコメントをつけておきました。
コメントブロック（ ' ）してありますのでこのままコピペしても大丈夫ですよ。

> 仕事での使用を想定してますので、『"Σ（￣ロ￣lll)"』だけは・・・使えません

はい、お好きにどうぞ。
ただ、わたしも会社で業務使用するコードをよく書きますが平気で使ってますけど・・・。（「遊び心」があって面白いなどと言われたりしてます。）

この回答へのお礼

コメントまで載せていただき、ありがとうございます！！
感謝、感謝です。
コピペ時に１行空けてたのは、merlionXX様のご配慮からだったのですね。思慮浅く、反省です。
おかげさまで、この質問第２弾を持ちまして、問題解決できそうです。
本当にお世話になりました。
ありがとうございました。

お礼日時：2009/04/10 08:53