将循环语句中的选定单元格粘贴到新工作表答案

【问题标题】：Pasting selected cells within a loop statement to a new worksheet将循环语句中的选定单元格粘贴到新工作表
【发布时间】：2017-11-17 19:12:38
【问题描述】：

我希望循环遍历一个列表，如果 E 列中的任何单元格包含“Y”，则复制该行中的数据并将其粘贴到下一个工作表上的下一个空行。

Private Sub CommandButton1_Click()

Dim Rec As Object
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets("Estimate")
Set pasteSheet = Worksheets("ACV & Supplement")
Set Rec = Range("E:E")

For Each cell In Rec
    If cell.Value = "Y" Then
        cell.Activate
        Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).Copy
        pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
Next

End Sub

在pasteSheet.Cells..... 行之前，一切都按照我的预期进行。

【问题讨论】：

您是否收到错误编号和消息，或者输出与预期不符？
不要循环，而是考虑按 Received 列过滤源，一步复制粘贴。
我遇到了一个错误，但是当我再次运行它时，它似乎已经按预期工作了。过滤想法可能会更有效，因此可以试一试。希望其他人能够将其用作参考。再次感谢
实际上，我想做的是剪切和粘贴选定的单元格，而不是复制它们。显然这并不像将“.Copy”更改为“.Cut”那么简单。有什么建议吗？

标签： excel vba loops rows copy-paste

【解决方案1】：

考虑使用自动过滤器，而不是循环（可能非常消耗资源）：

Dim copySheet As Worksheet: Set copySheet = Worksheets("Estimate")
Dim pasteSheet As Worksheet: Set pasteSheet = Worksheets("ACV & Supplement")

'Filter the sheet by Column E. Showing only rows where E has a "Y" value
copySheet.Range("E1:E99999").AutoFilter Field:=1, Criteria1:="Y", VisibleDropDown:=False

'Copy the worksheet
copySheet.Cells.SpecialCells(xlCellTypeVisible).Copy

'Paste the values
pasteSheet.Range("A1").PasteSpecial xlPasteValues

'Undo the filtering
copySheet.AutoFilterMode = False

'Get rid of the marching ants
Application.CutCopyMode = False

【讨论】：