复制动态范围并粘贴具有重复值的动态范围

Question

我想复制并粘贴动态范围。特别是每个复制范围源都有重复值的粘贴。这是我通过录制宏创建的代码：

if (input2 <= (d1 + d2) + human && 
    input2 >= (d1 + d2) - human)

这是我想要的截图输出：

Answer 1

Sub CopyPasteData()
Dim lRw As Long, lRw_2 As Long, x As Long, rActive As Range

Set rActive = ActiveCell
lRw = Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

Range("K2:R" & Rows.Count).ClearContents

For i = 2 To lRw
    x = x + 1
    Range("A" & i & ":H" & i).Copy
    lRw_2 = Cells(Rows.Count, "K").End(xlUp).Row + 1
    With Range("K" & lRw_2).Resize(6)
        .PasteSpecial xlPasteAll
        .Offset(, -1).Value = x
    End With
Next i

Application.CutCopyMode = False
rActive.Select
Application.ScreenUpdating = True

End Sub