最終行をコピーして、最終行＋１に貼り付けたい

Question

①Sheet1の品番とSheet2の品番が一致すれば、Sheet2の日付に本日を入れる
②Sheet1の品番がSheet2に存在しなければ、Sheet2の最終行をコピーして、Sheet2の最終行＋１に貼り付ける
Sheet1の品番、名称、コメントをSheet2の該当列に上書きする
※数式をコピーしたいので、上記手順をとっています。

Sheet１
品番｜名称｜コメント｜
001｜aaa｜あああ｜
003｜ccc｜ううう｜
004｜ddd｜えええ｜
005｜eee｜かかか｜

Sheet2
日付｜品番｜名称｜コメント｜数式｜数式2｜・・・続く
0512｜001｜aaa｜あああ｜数式｜数式2｜・・・続く
｜002｜bbb｜いいい｜数式｜数式2｜・・・続く
0512｜003｜ccc｜ううう｜数式｜数式2｜・・・続く
0512｜004｜ddd｜えええ｜数式｜数式2｜・・・続く

下記コードを作成してみたのですが、①はうまくいくのですが、②がうまくできません。
マクロ勉強中なのですが、ご教授ください。

sub test()
dim i as long
dim j as long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
n = ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Rows + 1

For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
For j = 2 To ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row

If ws1.Cells(i, 1).Value = ws2.Cells(j, 2).Value Then
   ws2.Cells(j, 1).Value = Date
Else
   '品番が一致しなければ、最終行をコピーして最終行＋１行目に貼り付けたい
   ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Rows.Copy Destination:=n
   ws2.cells(j,2).value = ws1.cells(i,1).value
   ws2.cells(j,3).value = ws1.cells(i,2).value
   ws2.cells(j,4).value = ws1.cells(i,3).value
End If

Exit For

Next j
Next i

End Sub

Answer 1

最終行の取得の仕方とCopyメソッドの使い方ミスと思われます。

n = ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Rows + 1
　↓
n = ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1

ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Rows.Copy Destination:=n
　↓
ws2.Rows(n - 1).Copy Destination:=ws2.Rows(n)

Comments

[退会済みユーザー]

ありがとうございます。勉強になりました！