文字制限を超えたセルに処理をしたい

Question

前提・実現したいこと

毎回お世話になっています。
現在、符号をA列、個数をB列、番号をC列に入れたリストを作っており
同じ符号を持った番号があれば上の行に個数と番号を入れる処理を作っています。
今回はその番号を入れたセルが20文字を超した時、セルを行挿入して結合する処理を作りたいのですが、
結合のコードが間違っているようで、エラーメッセージが表示されています。
どのように書けばよいのでしょうか。ご教授いただければ幸いです。

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

Rangeメソッドは失敗しました。 WorkSheetオブジェクト

該当のソースコード

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim SearchRange As Range
    Dim ResultRange As Range
    Dim KeyItem     As String
    Dim ResultNumber As String
    Dim ResultValue As Long, Num As Long
    Dim Rng As Variant
    Set SearchRange = Range("A2:A1000")  '探す符号の範囲

With Target
If Target.Count > 1 Then Exit Sub
If .Column = 3 And .Row >= 2 And .Value <> "" Then

    Application.EnableEvents = False

    If .Value <> "" Then
        .Value = "(" & .Offset(0, -1).Value & ")" & .Value

        KeyItem = .Offset(0, -2).Value '符号をキーにして探す

        For Each Rng In SearchRange     'SearchRangeのセル範囲をRngに代入して処理を繰り返す

            If Rng = KeyItem And Rng.Row <> Target.Row Then     'RngがKeyItemのセル中身と一致し、異なる行を選んだ

                ResultNumber = Rng.Offset(0, 2) & "," & Target.Value  '部品番号を入れる
                ResultValue = Rng.Offset(0, 1) + Target.Offset(0, -1).Value  '個数を足す
                Rng.Offset(0, 1) = ResultValue
                Rng.Offset(0, 2) = ResultNumber
                
                Target.Offset(0, -2).Resize(1, 3).ClearContents '選んだセルの範囲の1行3列をクリア
            
                Num = Len(Rng.Offset(0, 2))
                If Num >= 20 Then               '番号を入れたセルが20文字を超えた時
                    Rows(Rng.Row).Insert            '行挿入
                    Application.DisplayAlerts = False
                    
                    Rng.Offset(-1, 0) = Rng.Offset(0, 0)              'それぞれ一行上に値を挿入してからMerge
                    Rng.Offset(-1, 1) = Rng.Offset(0, 1)
                    Rng.Offset(-1, 2) = Rng.Offset(0, 2)
                    
                    Rng.Offset(0, 0).Resize(1, 3).ClearContents
                    
                    Range(Rng.Offset(0, 0) & ":" & Rng.Offset(-1, 0)).Merge
                    Range(Rng.Offset(0, 1) & ":" & Rng.Offset(-1, 1)).Merge
                    Range(Rng.Offset(0, 2) & ":" & Rng.Offset(-1, 2)).Merge

                    Application.DisplayAlerts = True
                End If

                Exit For
            End If
        Next

    End If
End If
End With

Application.EnableEvents = True
End Sub

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

使用したExcel:Excel2013

Answer 1

長いコードなので、精査してないですが、ぱっと見たところは、下記のコードは、

                    Range(Rng.Offset(0, 0) & ":" & Rng.Offset(-1, 0)).Merge
                    Range(Rng.Offset(0, 1) & ":" & Rng.Offset(-1, 1)).Merge
                    Range(Rng.Offset(0, 2) & ":" & Rng.Offset(-1, 2)).Merge

は下記ではないかと。

                    Range(Rng.Offset(0, 0), Rng.Offset(-1, 0)).Merge
                    Range(Rng.Offset(0, 1), Rng.Offset(-1, 1)).Merge
                    Range(Rng.Offset(0, 2), Rng.Offset(-1, 2)).Merge

あるいは、下記のように書いてもOK。

                    Rng.Offset(-1, 0).Resize(2).Merge
                    Rng.Offset(-1, 1).Resize(2).Merge
                    Rng.Offset(-1, 2).Resize(2).Merge

Comments

[memem12]

Rng.Offsetでセル範囲を示してしているので、その様に書けばよかったのですね。
ありがとうございました。