VBA 空白行に転記する

ExcelVBAで別シートへ転記するコードで空白行へ転記するコードわかりません。
・転記元シートは4つ
・転記先は1つ
・転記元の指定セルを指定し転記
・転記元ごとにボタンで処理
・各転記元のボタンで入力済行以下に追加転記
このような作動にしたいのです。

現在、シートからの通常の転記は以下のコードで作動しております。
-------------------------------
Sub チェックシート転記()
'①シートを変数にセット
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("転記元")
Set ws2 = Worksheets("転記先")

'②シートを指定してデータを転記
ws2.Range("B11:C26").Value = ws1.Range("A10:B25").Value
ws2.Range("B11:C26").Value = ws1.Range("A10:B25").Value
ws2.Range("D11:D26").Value = ws1.Range("D10:D25").Value
ws2.Range("E11:E26").Value = ws1.Range("F10:F25").Value
ws2.Range("F11:F26").Value = ws1.Range("H10:H25").Value
ws2.Range("G11:G26").Value = ws1.Range("I10:I25").Value
End Sub
-------------------------------
よろしくお願いします。

No.1 ベストアンサー 回答者： zongai 回答日時： 2020/10/20 09:49

最終行の取得　と

貼り付け先セル番号への組み込み　について知りたい
という感じでしょうか？

情報が記入される際に空欄にならない列を基準に最終行を取得しましょう。
ここでは「B列」を用いてみます。

x = ws2.Range("B10").End(xlDown).Row

これは、ws2.Range("B10") 連続した入力セルの最下端の行を取得します。

ws2.Range("B10")を選択した状態で、[CTRL]＋[↓]で移動した先のセルの行（Row）、と言えばわかりやすいでしょうか。

で、B11以降にデータが存在していればその最終行を取得しますが、
まっさらな状態（B10の項目しかない状態）であれば、
連続したデータがなく、シートの最下行を取得しちゃうんですね。
（先に書いた [CTRL]＋[↓]　をやってみればわかります）
なので・・・

x = ws2.Range("B10").End(xlDown).Row
If x = Rows.Count Then x = 11 Else x = x + 1

最終行＝シートの最終行であれば、貼り付け位置は11行目。
そうでなければ、貼り付け位置は、[データ連続の最終行＋1]行目
という処理を入れています。

下記は、貼り付け方法もちょっと変えてみたのですが、
これではいかがでしょうか？

Sub チェックシート転記1()
'①シートを変数にセット
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("転記元")
Set ws2 = Worksheets("転記先")

’ws2の貼り付け位置
x = ws2.Range("B10").End(xlDown).Row
If x = Rows.Count Then x = 11 Else x = x + 1

'②シートを指定してデータを転記
ws1.Range("A10:B25").Copy ws2.Range("B" & x)
ws1.Range("D10:D25").Copy ws2.Range("D" & x)
ws1.Range("F10:F25").Copy ws2.Range("E" & x)
ws1.Range("H10:H25").Copy ws2.Range("F" & x)
ws1.Range("I10:I25").Copy ws2.Range("G" & x)
End Sub


オリジナルに合わせれば、貼り付けはこうですね。

'②シートを指定してデータを転記
ws2.Range("B" & x & ":C" & x+15).Value = ws1.Range("A10:B25").Value
ws2.Range("D" & x & ":D" & x+15).Value = ws1.Range("D10:D25").Value
ws2.Range("E" & x & ":E" & x+15).Value = ws1.Range("F10:F25").Value
ws2.Range("F" & x & ":F" & x+15).Value = ws1.Range("H10:H25").Value
ws2.Range("G" & x & ":G" & x+15).Value = ws1.Range("I10:I25").Value

この回答へのお礼

早々の回答ありがとうございました。
オリジナルのコードで思った通りの作動となりました。
大変、勉強になり感謝致します。

改めましてありがとうございました。

お礼日時：2020/10/20 11:04