Arrays 基于第一列从一个电子表格复制和粘贴数组

希望这是有意义的： 我有一个主电子表格，列中有项目1-100。例如，项1下有4列，因此A1:D1被合并，但从第2行开始，它们仍然是单独的列。第2项只是一列，但第3项下有两列。没有押韵或理由的项目或多少列下，但他们不会改变

我正在寻找一种方法，可以转到另一个选项卡，称之为sheet1，并在页面顶部的单个单元格1、15、35、84、99中键入所需的数字，然后让宏从master复制相应的列，并按顺序粘贴它们

希望这是有意义的，而且很容易。我想在主选项卡中将1定义为单元格A1:D26，每当sheet1中有1时，它就会复制数组并粘贴它，然后转到下一个数字15，并执行与已定义的相同的操作。我必须以某种方式定义所有数组，但正如我所说，这些数组不会改变

任何建议都很好

谢谢

---

adam

以下代码应该完全满足您的要求；我认为除了变量名和注释之外，不需要对它进行解释

Option Explicit

Sub copyMerged()
Dim wsMaster As Worksheet
Dim wsTarget As Worksheet
Dim rNumbers As Range
Dim rSource As Range
Dim rDest As Range

Application.ScreenUpdating = False

Set wsMaster = ActiveWorkbook.Sheets("Master")
Set wsTarget = ActiveWorkbook.Sheets("Sheet1")

' delete all cells below first row
' otherwise we'll run in trouble with merged cells
wsTarget.Range([2:2], wsTarget.Cells.SpecialCells(xlCellTypeLastCell)).Delete
Set rNumbers = wsTarget.[A1]
Set rDest = wsTarget.[A2]
While Not IsEmpty(rNumbers)
  Set rSource = getRange(wsMaster, Int(rNumbers.Value))
  Set rNumbers = rNumbers.Offset(0, 1)
  rSource.Copy
  rDest.PasteSpecial
  Set rDest = rDest.Offset(0, 1).Cells(1, 1)
Wend

End Sub

Function getRange(ws As Worksheet, v As Integer) As Range
' return the vth merged cell in top row of ws
' and return the range from there to the bottom
Dim ii
Dim r As Range
Set r = ws.[A1]

For ii = 1 To v - 1
  Set r = r.Offset(0, 1)
Next ii

' select the entire merged cell... a bit weird
Set r = Range(r, r.Offset(0, 1).Offset(0, -1))

' extend to the last cell in the block below this
Dim r2 As Range
Set r2 = r.Offset([A:A].Rows.Count - 1, 0).End(xlUp)

Set getRange = Range(r, r2)

End Function

---

您是想自动计算出范围，还是计划在代码中硬连接它们？您很可能想使用VBA实现这一点-如果我是对的，您可能想相应地编辑要标记的问题。第二个问题-您想重写您的1,15,35,84,99，还是希望副本从下面开始？如果我可以用VBA定义它们那太好了。如果我需要硬写，我也可以。从1,15,35,84,99以下开始会更好，因为如果我需要添加一个数字22，假设我可以移动35,84,99并添加22，然后重新运行宏。很高兴我能提供帮助。您可以通过单击小复选标记选择接受答案。