Excel VBAでテーブル内の既存の行の内容を新しい行として複製する

やりたいこと

Excel VBAで、テーブル上の選択しているセルが属している既存の行の内容を、新しい行として複製するマクロを作りたい。この時、不要な列はコピーしないようにしたり、連番の列では数字を加算したりしたい。
このとき、このテーブルの一番左の列は数字の連番である。

環境

Microsoft Excel for Microsoft 365 MSO (バージョン 2409 ビルド 16.0.18025.20030) 64 ビット

やったこと

標準モジュールに以下のコードを書いてみた。

Option Explicit

Sub DuplicateSelectedRow()

'使う変数を宣言
Dim ws As Worksheet
Dim tbl As ListObject
Dim selectedRow As ListRow
Dim newRow As ListRow
Dim i As Integer

' アクティブなシートをオブジェクト変数に入れる
Set ws = ActiveSheet

' 選択しているセルがテーブル内にあるか確認する準備
On Error Resume Next 'ここでエラーが出ても次に行く。
Set tbl = ws.ListObjects(Selection.ListObject.Name)

'選択しているセルがテーブル内にあれば実行しなければ実行しない。
If Not tbl Is Nothing Then

    ' 選択しているセルが属している行を取得
    Set selectedRow = tbl.ListRows(Selection.Row - tbl.DataBodyRange.Row + 1)

    ' 新しい行を追加
    Set newRow = tbl.ListRows.Add

    ' 選択している行の内容を新しい行にコピー。ただし、ここで指定した列はコピーしない。
    For i = 1 To tbl.ListColumns.Count
        If i = 3 Then 'コピーしない列の番号を指定
            GoTo NextIteration
        End If
        newRow.Range.Cells(1, i).Value = selectedRow.Range.Cells(1, i).Value
        NextIteration:
    Next i

    ' 新しい行の一番左のセルの値を1行上のセルの値に1加算したものに設定
    If newRow.Index > 1 Then
        newRow.Range.Cells(1, 1).Value = tbl.ListRows(newRow.Index - 1).Range.Cells(1, 1).Value + 1
    End If

Else
    MsgBox "対象セルはテーブル内にありません。", vbExclamation
End If

End Sub

結果

意図した通りのマクロができた。

マクロ実行後のテーブル