VBA別シートの最終行の下行へ貼り付けされるようにしたいです。

教えてください。ド素人です。（参考書読み始めたところ）
聞き方も適切かわからないのですが、質問させてください。

Sheet1(入力画面）、Sheet2(確認画面）、Sheet3（データ）の3つのシートを作りました。

Sh1「入力画面」で入力された値は、関数で自動的に、Sｈ2「確認画面」指定のセルへコピーされるようにしています。
Sｈ1「入力画面」を入力し終えると。画面下のコマンドボタンで、Sｈ2「確認画面」へ画面が変わります。

そこで、内容を確認して、また、ここの下のコマンドボタンをクリックしてもらうと、Sｈ2「確認画面」の内容が、
Sｈ3（データ）の1行に集約されて貼り付けられます。同時にSｈ1「入力画面」の値は、クリアされ、Sｈ2「確認画面」も同様にクリアになります。

ここまで、完成したのですが、また、次のデータを入力していき、最後のSｈ3「データ」の最終行の下（空白行）に次々データを追加していくためのコードが解りません。

Sub ボタン3_Click()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Worksheets("入力画面")
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")

With sh2
.Range("C2:E2").Copy
Sheets("データ").Range("B2:D2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C3:C5").Copy
Sheets("データ").Range("E2:G2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
.Range("C6:D6").Copy
Sheets("データ").Range("H2:I2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C7:D7").Copy
Sheets("データ").Range("J2:K2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C8:D8").Copy
Sheets("データ").Range("L2:M2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C9:D9").Copy
Sheets("データ").Range("N2:O2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C10:C14").Copy
Sheets("データ").Range("P2:T2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
.Range("C17").Copy
Sheets("データ").Range("U2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
End With

With sh1
.Range("D8:K8").ClearContents
.Range("D6:K6").ClearContents
.Range("D4:K4").ClearContents
.Range("D10:K10").ClearContents
.Range("D12:J12").ClearContents
.Range("D14:L14").ClearContents
.Range("L16").ClearContents
.Range("D16:J16").ClearContents
.Range("D18:J18").ClearContents
.Range("L18").ClearContents
.Range("L20").ClearContents
.Range("D20:J20").ClearContents
.Range("L22").ClearContents
.Range("D22:J22").ClearContents
.Range("D24:H24").ClearContents
.Range("D26:H26").Value = "90"
.Range("D28:H28").Value = "80"
.Range("D30:H30").Value = "5"
.Range("D32:H32").Value = "5"
End With
Worksheets("入力画面").Activate
End Sub

ここまで、試行錯誤した内容です。
どこに最終行の下（空白行）の記述をいれられますでしょうか？
画像が一枚しかのせられなかったので、Sheet2(確認画面）だけ添付致しました。
Sheet3（データ）では、一行に集約しています。
是非、ご教授お願いします。色々なお意見がききたいです。

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2016/04/08 14:06

私も、ど素人のマクロで、オマケにどんどん今は劣化中です。

ただ、今は、もう参考にする本もなくなってしまいました。

ご質問は、非常にわかりやすいです。

必ず、起点が2行目にあるとすれば、
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row -1　'最後の次の行を探します。

そこに、Offsetで、ずらしていきます。

Sheets("データ").Range("B2:D2").Offset(i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
のようにして、全部、置換で、.Offset(i). を割りこませればよいでしょう。
検索：[).P] -> 置換：[).Offset(i).P]

以下で、添付したのは、マクロを集約してしまいました。
たぶん、私のコードは参考にはなりません。こんな考え方もあるのかなっていう程度にしてください。以下は、機械的に作られたものです。

'//--
Sub Test2Macro()
　　Dim sh1 As Worksheet: Set sh1 = Worksheets("入力画面")
　　Dim sh2 As Worksheet: Set sh2 = Worksheets("確認画面")
　　Dim sh3 As Worksheet: Set sh3 = Worksheets("データ")
　　Dim r1 As Range, a As Range
　　Dim i As Long, j As Long, k As Long
　　Dim Datas As Variant, c As Variant
　　
　　j = sh3.Cells(Rows.Count, 2).End(xlUp).Row + 1　'最後の行を探します。
　　Set r1 = sh2.Range("C2:E2,C3:C5,C6:D9,C10:C14, C17")
　　i = 2　'初期列
　　For Each c In r1.Cells
　　　　sh3.Cells(j, i).Value = c.Value
　　　　i = i + 1
　　Next c
　　
　　sh1.Range("D6:K6,D8:K8,D4:K4,D10:K10,D12:J12" & _
　　",D14:L14,L16,D16:J16,D18:J18,L18,L20" & _
　　",D20:J20,L22,D22:J22").ClearContents
　　Datas = Array(90, 80, 5, 5)
　　For Each a In sh1.Range("D26:H26,D28:H28,D30:H30,D32:H32").Areas
　　　　a.Value = Datas(k)
　　　　k = k + 1
　　Next a
End Sub
'//--

この回答へのお礼

WindFaller様、詳しく説明を頂き有難うございます。

Offsetとか、For～Nextの使い方がいまいちわからなかったんですよね～。
参考にさせて頂きます。集約して、短いコードが書けたら、かっこいいですものね。

試してみてまた、報告を書きます。

お礼日時：2016/04/08 19:48

No.4 回答者： hallo-2007 回答日時： 2016/04/08 21:51

ついでに

>.Range("C2:E2").Copy
>Sheets("データ").Range("B2:D2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
コピーと貼付けの繰り返しですが、データですので値だけで十分ですよね。
sh3.Range("B2:D2").Value=.Range("C2:E2").Value
と1行ですませます。もちろんパソコンの負担は絶対的に軽くなります。

データシートの最終行番号は
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row+1
して取得します。
Rows.Countはシートの持つ最大の行数で
エクセル２００７以上であれば、1048576行です。
B列の1048576行から上へ移動して空白でない行と云うのが
sh3.Cells(Rows.Count, 2).End(xlUp).Row
その一つ下の行番号ですので　+1 　ですね。

もう一つのテクニックですが、入力画面の1行目に行を挿入して
　　　A　　　　　　B　　　　　　　　　　C　　D
１　=Today()　=Max(データ!A:A)+1　=C2　=D2・・・・・
データが一行に表示されるように関数を入れておきます。
参考までに　A1に日付、B1には、データの管理番号が並ぶようしています。
目障りなら、1行目を非表示にしておきます。

VBAのコードは
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim i As Long
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row+1
sh3.Range("A" & i & ":U" & i).Value = Rnage("A2:U2").Value
後は、ClearContentsの部分

と云ったように10数行ほど完成する内容です。
関数などの機能と組み合わせることで
コードをシンプルにしておくと後々のメンテナンスも楽になります。
コピーと貼付けもむやみに使わない事です。

この回答へのお礼

hallo-2007さま、詳しい解説有難うございます。
なるほど、なるべくシンプルなコードにする工夫が、もっと必要ですね。
大変参考になります。
色々試させていただきたいと思います。

お礼日時：2016/04/09 23:00

No.3 回答者： ごまふあざらし 回答日時： 2016/04/08 19:23

No.1です、お礼ありがとうございます。

＞i = sh3.Range("B65530").End(xlDown).Row + 1
＞この構文の”B65530”が表している範囲が、よくわかりません。
これは単純にデータが被らないように大きい数字を当てているだけでして、
数字の範囲には大きな意味はありません。
例えば、貼り付けるデータの上限が1000であれば、
上記のBの値を1000に変えていただいても処理自体は変わりません。

No.1 回答者： ごまふあざらし 回答日時： 2016/04/08 13:50

一応確認ですが、貼り付けるデータは必ず数値または文字列が入っているものということでよろしいでしょうか。

もし必ずデータが入っているというのであれば、データシートの一番下の行を取得し、
確認画面シートのデータを貼り付けるところで行の位置をずらせば可能ではないでしょうか。

質問内容のソースをそのまま使用しますと、

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim i As Integer　'追加部分、データシートの一番下の行を格納する変数
Set sh1 = Worksheets("入力画面")
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")

'データシートの一番下の行を取得(B列にデータが必ずあるものとして記載してます)
i = sh3.Range("B65530").End(xlDown).Row + 1

と追加したら、次にデータシートの貼り付け位置の数値部分を変数で結合するようにします。

With sh2
.Range("C2:E2").Copy
sh3.Range("B" & i & ":D" & i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C3:C5").Copy
sh3.Range("E" & i & ":G" & i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
以下省略

そして最後に入力画面のシートを初期化する処理を持ってくればできるかと思います。

With sh1
.Range("D8:K8").ClearContents
.Range("D6:K6").ClearContents
以下省略

参考程度にどうぞ。

この回答へのお礼

ごまふあざらし様、詳しく説明頂いて有難うございます。

> 一応確認ですが、貼り付けるデータは必ず数値または文字列が入っているものということでよろしいでしょうか。
　　→はい、貼り付けるデータには必ず値が入っている状態になります。
>i = sh3.Range("B65530").End(xlDown).Row + 1
　　この構文の”B65530”が表している範囲が、よくわかりません。すみません。
　　取り敢えず、来週会社に行ってから、試してみます。（自宅のパソコンにはExcelが入ってないので・・・）

お礼日時：2016/04/08 19:11