Excel 将基于条件的数据复制到另一个工作表并清除内容

此代码用于将标记为“是”的奖励栏的过滤数据复制到另一张表中；但是，我收到一个类型不匹配的错误。我不是100%现在的代码工作正常，以过滤数据和复制正确。我目前有23行测试数据用于正确的功能。如果我只放了一行数据，那么它就不能正确地复制和粘贴数据。我只剩下复制的第一行数据和第二行空数据。此外，粘贴后不会清除行的内容，因此我可能会随着时间的推移添加新数据

副稿 作为整数的Dim i 将最后一行设置为整数 以字符串形式搜索 将列设置为整数 SheetsMasterData。激活 SheetsMasterData.RangeA1.Select '设置一个自动筛选，仅对“是”行进行排序。 自动筛选 '将字段：=5更改为具有Y/N的列的编号。 SheetsMasterData.Range$A$1:$G$200000.AutoFilter字段：=7，Criteria1:=Yes '查找最后一行 LastRow=SheetsMasterData.CellsSheetsMasterData.Rows.Count，A.EndxlUp.row i=1 '将3更改为Sheet2中的列数

---

请尽管我很抱歉对代码做了这么多修改，但看起来您可能过于复杂了

这是我之前回答的一个问题中的一些代码，其中有人希望在找到单词Total时突出显示特定的范围

我把结果改为“是”。将搜索范围更改为您的列。我认为G是对的

此外，为了将来参考，应[几乎永远]使用Select

它会大大降低代码执行速度，这是不需要的

我知道宏录制器喜欢使用它，但无需使用select即可引用所有内容

简要示例：

Sheets("ActiveJobStatus").Activate
Sheets("ActiveJobStatus").Cells(2, i).Select
ActiveSheet.Paste

可替换为：

Sheets("ActiveJobStatus").Cells(2, i).Paste

此代码用于将标记为“是”的奖励栏的过滤数据复制到另一张表中

只是代码：

结果:

主数据表：

活动工作状态表：

---

当我运行代码时，它没有识别错误行。数据仅从筛选后的数据复制，但如果它只是一行，它不会仅复制一行。我将把该范围扔到哪里。SpecialCellsxlCellTypeVisible？我试图将该代码放入带有.Range的行中，但我现在得到了一个错误对象未找到列标题Job Builder社区地段地址城市奖励数据：2015 BullardHomes Sample2 22 2222 Main St Fakeville NoAwesome，我明天早上回到办公室时会检查一下。我很感谢你的帮助。很抱歉，我花了这么长时间才帮到你——我第一次发表评论时正在打电话。基本上，我们得到了ActiveJobStatus A列的最后一行，您可以将其更改为任何内容，这就是我们粘贴Yes awards的地方，我们可以将EntireRow-将E:E更改为awards是任何内容的列。我试图对其进行评论，以便您了解它在做什么-希望这有帮助，我将在明天与您联系，谢谢您的帮助。这要快得多，当我运行宏时屏幕不会闪烁。干得好。很高兴听到，很乐意帮忙。

Sub CopyAwardsToActiveJobStatusSheet()

Dim SearchRange, First, Finder As Range
Dim PasteRow as Integer 'Add this to increment the rows we paste your data to

Set SearchRange = Sheets("MasterData").Range("G:G") 'Search This Range for "Yes"

Set Finder = SearchRange.Find("Yes") 'This is what we're looking for
If Finder Is Nothing Then Exit Sub   'We didn't find any "Yes" so we're done

'Drastically increases speed of every macro ever
'(well, when the sheets are modified at least - and it doesn't hurt)
Application.ScreenUpdating = False 

First = Finder.Address 'Grab the address of the first "Yes" so we know when to stop

'Get the last row of column "A" on ActiveJobStatusSheet and start pasting below it
PasteRow = Sheets("ActiveJobStatus").Cells(Sheets("ActiveJobStatus").Rows.Count, "A").End(xlUp).Row + 1
Do
    'Copy the entire row and paste it into the ActiveJobStatus sheet
    'Column A and PasteRow (the next empty row on the sheet)
    'You can change these if needed
    Finder.EntireRow.Copy Sheets("ActiveJobStatus").Range("A" & PasteRow)

    'If you just want A:G, you can use this instead:
    'Finder returns the cell that contains "Yes",
    'So we offset/resize to get the 6 cells before it and just copy that
    'Resize doesn't like negative numbers so we have to combine:

    'Finder.Offset(,-6).Resize(,7).Copy Sheets("ActiveJobStatus").Range("A" & PasteRow)

    'Look for the next "Yes" after the one we just found
    Set Finder = SearchRange.FindNext(after:=Finder)

    PasteRow = PasteRow + 1 'Faster than looking for the end again

'Do this until we are back to the first address
Loop While Not Finder Is Nothing And Finder.Address <> First

'Clear MasterData
Sheets("MasterData").Range("A2:G" & Sheets("MasterData").UsedRange.Rows.Count).ClearContents

Application.ScreenUpdating = True 'Drastically increases speed of every macro ever.
End Sub

Sub CopyAwardsToActiveJobStatusSheet()
Dim SearchRange, First, Finder As Range
Dim PasteRow as Integer
Set SearchRange = Sheets("MasterData").Range("G:G")
Set Finder = SearchRange.Find("Yes")
If Finder Is Nothing Then Exit Sub
Application.ScreenUpdating = False 
First = Finder.Address
PasteRow = Sheets("ActiveJobStatus").Cells(Sheets("ActiveJobStatus").Rows.Count, "A").End(xlUp).Row + 1
Do
    Finder.EntireRow.Copy Sheets("ActiveJobStatus").Range("A" & PasteRow)
    Set Finder = SearchRange.FindNext(after:=Finder)
    PasteRow = PasteRow + 1
Loop While Not Finder Is Nothing And Finder.Address <> First
Sheets("MasterData").Range("A2:G" & Sheets("MasterData").UsedRange.Rows.Count).ClearContents
Application.ScreenUpdating = True
End Sub