复制和粘贴循环 - 编程之家

如何解决复制和粘贴循环

我有两张纸：Sheet 1 和 Sheet 2。

Sheet 1 只有一列 (Column A) 和多行。 Product 1、Product 2...等
Sheet 2 有多个行和列。
目标是对于 Sheet 1 中的每个单元格（以 A2 开头），将所有 Sheet 2 复制并粘贴到新工作表 Sheet 3 上。循环直到 Sheet 1 中出现一个空白单元格。

例如：Product 1 将在 x 中出现 Column A 次，相应的行在 Sheet 2 中。然后 Product 2 将在 x 下出现 Product 1 次，Sheet 2 中的各行相同。

下面是我想要做的一个非常粗略的宏。


Sub copy_Paste_Loop()
'
' copy_Paste_Loop Macro
'

'
    Range("B2:C2").Select
    Range(Selection,Selection.End(xlDown)).Select
    Selection.copy
    Sheets.Add After:=ActiveSheet
    Range("B1").Select
    ActiveSheet.Paste
    Selection.Columns.AutoFit
    Sheets("Sheet2").Select
    Range("B3").Select
    Application.CutcopyMode = False
    Selection.copy
    Sheets("Sheet2").Select
    Range("B2:B3").Select
    Application.CutcopyMode = False
    Selection.copy
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A2").Select
    Application.CutcopyMode = False
    Selection.AutoFill Destination:=Range("A2:A106")
    Range("A2:A106").Select
    Range("B2").Select
    Range(Selection,Selection.End(xlToRight)).Select
    Range(Selection,Selection.End(xlDown)).Select
    Selection.copy
    Selection.End(xlDown).Select
    Range("B107").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("B4").Select
    Application.CutcopyMode = False
    Selection.copy
    Sheets("Sheet3").Select
    ActiveWindow.SmallScroll Down:=9
    Range("A107").Select
    ActiveSheet.Paste
    Application.CutcopyMode = False
    Selection.AutoFill Destination:=Range("A107:A211")
    Range("A107:A211").Select
End Sub