VBA sheet1の値とsheet2の値を入れ替えたい

Question

前提・実現したいこと

VBA入門者です。VBAで画像のsheet1の"C000...=..."という値が入っている行の＝より右の値６個をsheet2のX=、Y=、Z=、W=、P=、R=の順（sheet1でいう一番左の値をX=に代入）に単位は残して、数字の部分だけ入れ替えたいと思い、ネットサーフィンをし、なんとか以下のプログラムを作成しました。
プログラムの実行はできたのですが、以下の画像②のように入れ替える量を増やすと実行されません。本番では、もっと大量の値を交換したいです。

どこを変更すればよいか教えてください。宜しくお願いします。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

ソースコード
```Sub Sample()
Dim buf1, buf2, tmp2
Dim i As Long, j As Long, n As Long, m As Long, r As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
r = 1
For i = 6 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
If sh1.Cells(i, "A") Like "C*" Then
For j = 1 To 6
If j > 3 Then
n = j - 3
m = 1
Else
n = j
m = 0
End If
buf2 = Split(sh2.Cells(r, n).Offset(m), "=")
tmp2 = Split(Trim(buf2(1)), Chr(32))(0)
Select Case InStr(sh1.Cells(i, j), "=")
Case Is <> 0
buf1 = Split(sh1.Cells(i, j), "=")
sh1.Cells(i, j) = buf1(0) & "=" & tmp2
sh2.Cells(r, n).Offset(m).Replace tmp2, buf1(1), LookAt:=xlPart
Case Else
buf1 = sh1.Cells(i, j)
sh1.Cells(i, j) = tmp2
sh2.Cells(r, n).Offset(m).Replace tmp2, buf1, LookAt:=xlPart
End Select
Next j
End If
r = r + 3
Next i
Application.ScreenUpdating = True
End Sub


### 試したこと

ここに問題に対して試したことを記載してください。

### 補足情報（FW/ツールのバージョンなど）

Comments

[Y.H.]

> 以下の画像②のように入れ替える量を増やすと実行されません
デバッグでブレークポイント追加してステップ実行でどうなってるか確認しましたか？

[Usirow]

①で動いている以上、②にしたからといって全く実行されないということはないと思います。
違うブックを開いて実行したなどはありませんか？

[radames1000]

https://teratail.com/questions/308838
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10235351785
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q10235524460
退会してますし、丸投げですし、自分でまったく書いてないですよね。
知恵袋で解決したようです。

Answer 1

こちらで動作確認はしていません。
r = r + 3 の位置を変えています。
これで、期待した通りに動作すると思います。

Sub Sample()
    Dim buf1, buf2, tmp2
    Dim i As Long, j As Long, n As Long, m As Long, r As Long
    Dim sh1 As Worksheet, sh2 As Worksheet
    Application.ScreenUpdating = False
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    r = 1
    For i = 6 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
        If sh1.Cells(i, "A") Like "C*" Then
            For j = 1 To 6
                If j > 3 Then
                    n = j - 3
                    m = 1
                Else
                    n = j
                    m = 0
                End If
                buf2 = Split(sh2.Cells(r, n).Offset(m), "=")
                tmp2 = Split(Trim(buf2(1)), Chr(32))(0)
                Select Case InStr(sh1.Cells(i, j), "=")
                Case Is <> 0
                    buf1 = Split(sh1.Cells(i, j), "=")
                    sh1.Cells(i, j) = buf1(0) & "=" & tmp2
                    sh2.Cells(r, n).Offset(m).Replace tmp2, buf1(1), LookAt:=xlPart
                Case Else
                    buf1 = sh1.Cells(i, j)
                    sh1.Cells(i, j) = tmp2
                    sh2.Cells(r, n).Offset(m).Replace tmp2, buf1, LookAt:=xlPart
                End Select
            Next j
            r = r + 3       'ここに移動
        End If
    Next i
    Application.ScreenUpdating = True
End Sub