ステップインを行うと問題なくプログラムが実行されるが、実行を行うとうまく動かない

Question

前提・実現したいこと

VBAでプログラムを作成しています、
シート内で文字検索をし、検索結果のセルを特定の数だけ移動したセルを取得し、新規作成した別のシートに値を貼り付ける作業を全シート行いたいです。

ステップインを行うと問題なくプログラムが実行されますが、実行のみを行うと貼付が行われないので原因が知りたいです。
ただ、コピーは実行されているみたいです。

該当のソースコード

Sub test()


    Dim x As Long
    Dim y As Long
    Dim myRange As Range   
    Dim firstCell As String  
    Dim yokin As Range 
    Dim memo As Range 
    Dim copycell As Range
    Dim copysheet As String
      
    copysheet = InputBox("シート名を入力してください", "新規作成")    
    
　　Worksheets("コピー元").Copy after:=Worksheets(1)
    ActiveSheet.Name = copysheet
   
    
    x = 6
    
    For y = 1 To Worksheets.Count
        
        Worksheets(y).Activate
        Set myRange = Worksheets(y).Cells.Find("103-00002")  
        
        If Not myRange Is Nothing Then  
            firstCell = myRange.Address
                        
            Do
                Set yokin = ActiveSheet.Cells(myRange.Row, myRange.Column + 4)
                Set memo = ActiveSheet.Cells(myRange.Row, myRange.Column + 19)
                
                If yokin > 0 Then
                    Union(ActiveSheet.Cells(yokin.Row, yokin.Column), ActiveSheet.Cells(memo.Row, memo.Column)).Select
                    Selection.Copy
                    Worksheets(2).Activate
                    Cells(x, "c") = Worksheets(y).Name
                    Cells(x, "i").Select
                    ActiveSheet.Paste
                    x = x + 1
                    Worksheets(y).Select
                End If
                
                Set myRange = Cells.FindNext(myRange)  
            
            
            Loop While myRange.Address <> firstCell 
            
        End If
    
    Next
    
    Worksheets(2).Activate

End Sub

試したこと

Worksheets(2).Activate
Cells(x, "c") = Worksheets(y).Name

上のどちらかににブレークポイントを設置し、実行すればステップインをした時と同様に実行結果が得られますが、
ここ以外にブレークポイントを設置する、またはデバックせずにそのまま実行するとうまく貼り付けが実行されてくれません。

Comments

[gentaro]

「ここら辺が原因なのはわかっている」というのはどういう事でしょうか。
通常、原因がわかれば解決できるはずです。
質問文を編集して、説明を追記して下さい。

[aberudain]

ここにブレークポイントを設置し実行すると貼付が実行されます。
ステップインでも同様に問題なく実行されます。

ただ、ブレークポイントを設置しないで実行、または別の場所にブレークポイントを置いて実行すると貼り付けができていません。
似たような事例があれば教えていただきたいです。

[gentaro]

その説明も全然ピンときませんが、それが起こったことを正確に記述できているのであれば「質問文を編集して追記して下さい」

[hatena19]

ソースコードはマークダウン記法のソースタグで囲んでください。
分からなければ、ソースを選択した状態でツールバーの <code> をクリックしてください。

[coco_bauer]

「Cells(x, "c") = Worksheets(y).Name」の Cellsの使い方は間違っています。
Cellsの引数は２つで、一つ目が行番号、二つ目が列番号を指定します。　C4 セルを指定するなら、Cells(4,3)となります。

[hatena19]

Cells の第2引数には、列番号でも列名（アルファベット）でも指定できますので間違ってません。
まあ、誤解を生みやすいので、Range("C" & x) とするか、Cells(x, 3) の方がいいとは思いますが。

Answer 1

memo は条件式によって格納されますよね。
If yokin.Value > 0 Then　のときだけ
newWS.Cells(x, "j").Value = memo.Value　
memoの値を代入してます。
ゆえに条件式にはまらないときの処理漏れによって
memoが格納されないのではないでしょうか？

Answer 2

実際にテストしたわけではないので原因の指摘はできないが、
とりあえずおかしいと思える部分の指摘とコーディングのアドバイスをしておきます。

For y = 1 To Worksheets.Countと全シートを対象に処理を行っているが、"コピー元"シートと新規作成したシートは対象から除外する必要があるのでは。

Activate、Select してアクティブなシートやセルを対象に処理しているが、不安定要因になるので、オブジェクト変数に代入するか、Withステートメントで指定して、それに対して処理を実行するようにした方がいいでしょう。また、その方か読みやすいです。

また、Copy Paste ではなく、Value を使って代入したほうが高速です。

さらに、変数宣言は以前は冒頭にまとめて宣言するのが普通でしたが、最近は使う直前に宣言するのがトレンドです。
VBA - 見やすい 変数の 宣言位置｜teratail

上記の方針に基づいて現状のコードを書き換えてみました。

Sub test()

    Dim copycell As Range
    
    Dim copysheet As String
    copysheet = InputBox("シート名を入力してください", "新規作成")

    Dim newWS As Worksheet
    Set newWS = Worksheets("コピー元").Copy(after:=Worksheets(1))
    newWS.Name = copysheet

    'Set copycell = ActiveSheet.Cells(6, "i")
    
    Dim x As Long '挿入開始行
    x = 6

    '"コピー元"シートが一番目、その後に新規作成シートを挿入すると仮定しました
    'もしそうでないなら、シート名をチェックして"コピー元"とcopysheetはとばすようにする
    Dim y As Long
    For y = 3 To Worksheets.Count
        With Worksheets(y)
        Set myRange = .Cells.Find("103-00002")

        If Not myRange Is Nothing Then

            Do
                Dim yokin As Range
                Dim memo As Range
                Set yokin = .myRange.Offset(, 4) '右へ4列分移動
                Set memo = .myRange(, 19) '右へ19列分移動

                If yokin.Value > 0 Then
                    'Union(yokin, memo)
                    newWS.Cells(x, "c").Value = .Name.Value
                    newWS.Cells(x, "i").Value = .yokin.Value
                    newWS.Cells(x, "j").Value = .memo.Value
                    x = x + 1
                End If

                Set myRange = Cells.FindNext(myRange)

            Loop While myRange.Address <> firstCell

        End If

    Next

    newWS.Activate

End Sub

Comments

[aberudain]

```vba
Sub test()

Dim x As Long
Dim y As Long
Dim myRange As Range
Dim firstCell As String
Dim yokin As Range
Dim memo As Range
Dim copycell As Range
Dim copysheet As String

copysheet = InputBox("シート名を入力してください", "新規作成")

Dim newWS As Worksheet
Worksheets("コピー元").Copy after:=Worksheets(1)
Set newWS = ActiveSheet
newWS.Name = copysheet

x = 6

For y = 3 To Worksheets.Count

Worksheets(y).Activate
Set myRange = Worksheets(y).Cells.Find("103-00002")

If Not myRange Is Nothing Then
firstCell = myRange.Address

Do
Set yokin = myRange.Offset(, 4)
Set memo = myRange(, 19)

If yokin.Value > 0 Then
newWS.Cells(x, "c").Value = Worksheets(y).Name
newWS.Cells(x, "i").Value = yokin.Value
newWS.Cells(x, "j").Value = memo.Value
x = x + 1
End If

Set myRange = Cells.FindNext(myRange)

Loop While myRange.Address <> firstCell '?????Z????????Do~Loop??p??

End If

Next

newWS.Activate

End Sub

```

ご回答を参考にして元の形を残しつつエラーが出ないように修正いたしました。
ただ、シート名、yokin,memoそれぞれ貼付ができるようになりましたが、memoだけ
ランダムで取得漏れがあるみたいです。
それでも全く貼り付けができなかったことに比べればだいぶましになりました。
ありがとうございます。

[nanami12]

memo は条件式によって格納されますよね。
If yokin.Value > 0 Then　のときだけ
newWS.Cells(x, "j").Value = memo.Value　
memoの値を代入してます。
ゆえに条件式にはまらないときの処理漏れによって
memoが格納されないのではないでしょうか？

[aberudain]

解決しました。
貼りつけられたメモ内容に違和感を覚えよく確認したところ、想定した場所の隣のセルを代入していました。
そのためベストアンサーは丁寧に添削してくださったhatena19様にいたしました。
ですが、nanami12様のコメントによりシートをよく見比べて原因がわかりましたので誠にありがとうございます。