复制和粘贴循环

编程问答 2022-05-28

问题描述

我有两张纸：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

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

copyforeachloopspaste