VBAで別シートへの転記がしたい

Question

あるシートにリスト形式で記載されている内容を
別シートに自動的に転記できるようにしたいと考えています。
下記のコードを記載したところ、一度はうまくいったのですが
毎回くるくるマークが表示されてエクセルが壊れてしまいます。
コードが誤っているのでしょうか。ご教示頂けますと幸いです。

Sub createReport_project2()

Dim ctrRow
Dim i
Dim endRow
ctrRow = 4
endRow = Range("A3").End(xlDown).Row
For i = 3 To endRow
Worksheets("事務局使用欄_registerextrarole").Range("E" & ctrRow).Value = Range("A" & i).Value
Worksheets("事務局使用欄_registerextrarole").Range("F" & ctrRow).Value = Range("B" & i).Value
ctrRow = ctrRow + 1

Next i

End Sub

Answer 1

最終行を求めるところでシートの一番底になってしまったのではないでしょうか。
３行目だけに値があり４行目以降が空白の場合、Range("A3").End(xlDown)ではそうなってしまいます。
こうした場合、逆に一番底からEnd(xlUp)するのがよくある手です。

あるいは、処理の実行時に転記元のシートがActiveになっておらず、別のシートで最終行を求めてしまった可能性もあります。特に複数シートを扱う場合は、できるだけ明示的にシート名を指定してオブジェクト変数に格納するのが間違いを避けるコツです。

Sub createReport_project2()

    Dim ctrRow
    Dim i
    Dim endRow
    
    Dim moto As Worksheet
    Dim saki As Worksheet
    
    Set moto = Worksheets("転記元シート")
   'endRow = moto.Range("A3").End(xlDown).Row
    endRow = moto.Range("A" & moto.Rows.Count).End(xlUp).Row
    
    Set saki = Worksheets("事務局使用欄_registerextrarole")
    ctrRow = 4
    
    For i = 3 To endRow
        saki.Range("E" & ctrRow).Value = moto.Range("A" & i).Value
        saki.Range("F" & ctrRow).Value = moto.Range("B" & i).Value
        ctrRow = ctrRow + 1
    Next i

End Sub

Comments

[KongIho]

最終行を求めるところで一番底になっていました。
無事に解決しました。大変分かりやすくコードまでご教示いただき、誠にありがとうございました！！