複製動態範圍並粘貼具有重複值的動態範圍

Question

我想複製和粘貼動態範圍。特別是對每個複製範圍源粘貼重複值。下面是代碼，我從錄製宏創建：

Sub copyRange() 
Range("A2").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Selection.Copy 
Range("L2:S7").Select 
ActiveSheet.Paste 

Range("A3").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Range("L8:S13").Select 
ActiveSheet.Paste 

Range("A4").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Range("L14:S19").Select 
ActiveSheet.Paste 

Range("A5").Select 
Range(Selection, Selection.End(xlToRight)).Select 
Application.CutCopyMode = False 
Selection.Copy 
ActiveWindow.SmallScroll Down:=3 
Range("L20:S25").Select 
ActiveSheet.Paste 
End Sub 

這是截圖輸出，我想：

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