編集結果を転記する A列の7項目ごとの 繰り返し vba

Sub 編集結果を転記する()
'売上見込み編集
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    Dim targetColumn As Long
    Dim sourceColumns As Long
    
        '編集結果シート初期化
    Sheets("編集結果").Select
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    
    
    ' データが格納されているシートを設定
    Set sourceSheet = ThisWorkbook.Sheets("Data")
    ' 編集結果を格納するシートを設定
    Set targetSheet = ThisWorkbook.Sheets("編集結果")
    
    ' 最終行を取得
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
    ' 転記先の最初の行を設定
    targetRow = 2
    ' 転記先の最初の列を設定
    targetColumn = 1
    
    
    ' 編集結果シートの内容をクリア
    targetSheet.Rows("2:" & targetSheet.Rows.Count).ClearContents
    
    ' 商品名2と金額を別シートに転記
    For i = 1 To lastRow Step 7
        ' データが存在する場合のみ処理
        If sourceSheet.Cells(i, 1).Value <> "" And sourceSheet.Cells(i + 1, 1).Value <> "" Then
        
        Dim R As Long 'Dataシートの列　A2～A7　;　7項目ごとの 繰り返し
        For R = 1 To 6
                targetSheet.Cells(targetRow, R).Value = sourceSheet.Cells(i + R, 1).Value
        Next R
                
            targetRow = targetRow + 1 ' 転記先の行を更新
        End If
    Next i

    ' 販売利益の合計を編集結果シートに挿入
    targetSheet.Cells(targetRow, 1).Value = "販売見込みの合計"
    targetSheet.Cells(targetRow, 2).Value = WorksheetFunction.Sum(Range("b2:b" & targetRow))
    Range("A1").Select
End Sub