ＶBA 別シートにコピペ後、値クリア

質問

お世話になります。ＶＢＡ初心者です。エクセルにてコマンドボタン（SHEET1上に配置）をクリックすることで下記を実行するにはどうしたら良いですか。

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

(2)；(1)を実行後、再度SHEET1のB3:L9に値を入力を行い、同じコマンドボタンをクリックすると、今度は(1)で貼り付けたSHEET2のB3:L9の下（２回目なのでB10:L16）に改行して貼り付ける。貼り付け後は(1)と同様。これをくりかえし（B17:L23,B24:L30....）。

SHEET1に入力した値をSHEET2に記録として残しておくために、このようなことをしたいと考えます。どうか宜しくお願いします。

回答No.3

merlionXX · ベストアンサー

B列のどこかひとつにでも入力があれば以下で大丈夫だと思います。
C～L列の入力の有無は問いません。

Private Sub CommandButton1_Click()
Dim x As Long, xx As Long
Dim Rng As Range
Set Rng = Sheets("Sheet1").Range("B3:L9")
x = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
If x > 2 Then
xx = Application.Ceiling(x - 2, 7) + 3
Else
xx = 3
End If
Rng.Copy Sheets("Sheet2").Range("B" & xx)
Rng.ClearContents
End Sub

お礼

ご回答ありがとうございます。
おかげさまで問題が解決できました。お手数をおかけしました。
ありがとうございました。

回答No.2

redfox63

補足元データの範囲で未入力の行がある場合誤動作します
たとえば B8:L9が未入力だった場合などです

先の投稿の既存データがある場合の部分を
dim n as intger
n = Trg.Rows( Trg.Ros.Count ).row - 3
' 取得した行数の最後が 元データの行数の整数倍かをチェック
if n mod Src.Rws.Count <> src.ows.Count - 1 then
　　n = ( ( n \ Src.Rws.Count ) + 1 ) * Src.Rws.Count
end if
set trg = Trg.Offset( n ).Resize( Src.Rws.Count )
といった具合の調整が必要でしょう

お礼

再びのご回答ありがとうございます。
今回の件につきましては、回答番号：No.3様のご回答を採用させて
いただき、対応しようと思います。お手数をおかけしました。
ありがとうございました。

回答No.1

redfox63

Sub Test
　　dim Src as Range, Trg as Range
　　' コピー元設定
　　set src = Sheet1.Range("B3:L9")
　　' 既存のコピー先の取得
　　Set Trg = InterSect( Sheet2.Range("B:L"), Sheet2.UsedRange)
　　if Trg Is Nothing then
　　　　' 既存のデータが無い場合
　　　　Set Trg = Sheet2.Range("B3:L9")
　　else
　　　　' 既存のデータがある場合
　　　　Set Trg = Trg.Offset(Trg.Rows.Count).Resize(Src.Rows.Count )
　　end if
　　' データの転記
　　Trg.Value = Src.Value
　　’　元データ領域のクリア
　　Src.Value = ""
End Sub
といった具合で ...

お礼

さっそくのご回答ありがとうございます。
今後のために参考にさせていただきます。ご回答内容の中には？？？な部分がかなりあります（超初心者なもので・・・）が、なんとか勉強したいと思います！！