指定した行を指定した間隔でコピー

''' <summary>
''' 処理名:createTestTemplate
''' 概要:指定シートにテスト結果記録用のテンプレート行を指定件数分作成する。
'''       4行目以降のセルと画像を全クリアした後、2~3行目を指定間隔でコピーする。
''' </summary>
Sub createTestTemplate()
    Dim lngCount As Long
    Dim lngIdx As Long
    Dim lngDstRow As Long
    Dim lngLastRow As Long
    Dim lngBlockSize As Long
    Dim shpObj As Shape
    Dim strInput As String
    Dim wstTarget As Worksheet
    Const C_ROW_INTERVAL As Long = 42
    Const C_SRC_START As Long = 2
    Const C_SRC_END As Long = 3
    Const C_SHEET_NAME As String = "Sheet1"
    
    On Error Resume Next
    Set wstTarget = ThisWorkbook.Worksheets(C_SHEET_NAME)
    On Error GoTo 0
    
    If wstTarget Is Nothing Then
        MsgBox "シート「" & C_SHEET_NAME & "」が見つかりません。", vbExclamation
        Exit Sub
    End If
    
    strInput = InputBox("項目数を入力してください。", "テンプレート作成")
    
    If strInput = "" Then
        Exit Sub
    End If
    
    If Not IsNumeric(strInput) Then
        MsgBox "数値を入力してください。", vbExclamation
        Exit Sub
    End If
    
    lngCount = CLng(strInput)
    
    If lngCount < 1 Then
        MsgBox "1以上の数値を入力してください。", vbExclamation
        Exit Sub
    End If
    
    'テンプレート行数 + 空き行数
    lngBlockSize = (C_SRC_END - C_SRC_START + 1) + C_ROW_INTERVAL
    
    Application.ScreenUpdating = False
    
    With wstTarget
        '既存の画像を全削除
        For Each shpObj In .Shapes
            shpObj.Delete
        Next shpObj
        
        '4行目以降を全クリア
        lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lngLastRow >= 4 Then
            .Rows("4:" & lngLastRow).Clear
        End If
        
        '1件目のNo.にROW関数を設定
        .Cells(C_SRC_START, 2).Formula = "=(ROW()-" & C_SRC_START & ")/" & lngBlockSize & "+1"
        
        '2件目以降をコピー
        For lngIdx = 1 To lngCount - 1
            lngDstRow = C_SRC_START + (lngBlockSize * lngIdx)
            .Rows(C_SRC_START & ":" & C_SRC_END).Copy Destination:=.Rows(lngDstRow)
        Next lngIdx
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox lngCount & "件分のテンプレートを作成しました。", vbInformation
End Sub