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

Question

我希望循环遍历列表，如果列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.....行。

Answer 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