如何在每个工作表中查找范围并将每个范围粘贴到一个工作表中

我正试图在这里做三件事。 三分之二的人似乎在工作：

1. 我试图通过每个工作表循环（在标题为“封面”的工作表之后开始）。 这似乎是工作。

2. 在每个工作表中，我正在searchD列中包含“已分配”的单元格。 这也似乎在起作用。

3. 在每个工作表中，该单元格下面应该是一行或多行数据（包含在D到J列中）。 我想将每个工作表中的数据复制到一个名为“Due Outs”的工作表中。 我无法让这一步工作。

我的代码如下。 我在match.CurrentRegion.Select不断收到运行时1004错误 ，因为Range类的select方法失败。 我已经尝试了几个变化，包括resize和偏移，并不断得到相同的错误。

 Sub macroGetDue() Dim ws As Worksheet Dim match As Range Dim findMe As String Dim StartIndex As Integer StartIndex = Sheets("Cover Sheet").Index + 1 findMe = "Assigned on" For Each ws In Worksheets If ws.Index > StartIndex Then Set match = ws.Range("D:D").Find(findMe).Offset(1) match.CurrentRegion.Select Selection.Copy Sheets("Due Outs").Range("D" & Rows.Count).End(xlUp).Offset(1).Select Selection.Paste End If Next ws End Sub 

Answer 1

总是build议避免使用select，您可以复制范围到另一个不使用它。 大多数情况下，由于WS未处于活动状态，因此失败。

最好像这样直接复制：

 match.CurrentRegion.Copy Sheets("Due Outs").Range("D" & Rows.Count).End(xlUp).Offset(1)