将基于标准的数据复制到另一张纸上并清除内容

此代码正在努力将标记为“是”的“获奖”列的过滤数据复制到另一张表; 但是，我收到“types不匹配”的错误。 我现在不是100％的代码正常工作，以过滤数据和正确复制。 我目前有23行testing数据的正确function。 如果我只放一行数据，那么它不会正确复制和粘贴数据。 我剩下复制的第一行数据加上第二个空行数据。 此外，它不会清除粘贴后行的内容，所以我可以随着时间的推移添加新的数据。

Sub CopySheet() Dim i As Integer Dim LastRow As Integer Dim Search As String Dim Column As Integer Sheets("MasterData").Activate Sheets("MasterData").Range("A1").Select 'Sets an Autofilter to sort out only your Yes rows. Selection.AutoFilter 'Change Field:=5 to the number of the column with your Y/N. Sheets("MasterData").Range("$A$1:$G$200000").AutoFilter Field:=7, Criteria1:="Yes" 'Finds the last row LastRow = Sheets("MasterData").Cells(Sheets("MasterData").Rows.Count, "A").End(xlUp).row i = 1 'Change the 3 to the number of columns you got in Sheet2 Do While i <= 11 Search = Sheets("ActiveJobStatus").Cells(1, i).Value Sheets("MasterData").Activate 'Update the Range to cover all your Columns in MasterData. If IsError(Application.Match(Search, Sheets("MasterData").Range("A1:G1"), 0)) Then 'nothing Else Column = Application.Match(Search, Sheets("MasterData").Range("A1:G1"), 0) Sheets("MasterData").Cells(2, Column).Resize(LastRow, 1).Select Selection.Copy Sheets("ActiveJobStatus").Activate Sheets("ActiveJobStatus").Cells(2, i).Select ActiveSheet.Paste End If i = i + 1 Loop 'Clear all Y/N = Y 'Update the Range to cover all your Columns in MasterData. Sheets("MasterData").Activate Column = Application.Match("Award", Sheets("MasterData").Range("A1:F1"), 0) Sheets("MasterData").Cells(2, Column).Resize(LastRow, 1).Select Selection.ClearContents End Sub 

Answer 1

对不起，改变你的代码太多了，但看起来你可能会过度复杂如何做到这一点。

这是以前的问题的一些代码，我回答了有人想要突出某个特定的范围，只要find“总计”一词。

我将发现改为“是”。 将SearchRange更改为您的列。 （我认为G是对的）。

另外，为了将来的参考，select应该[ 几乎从不 ]被使用。

它会减慢代码的执行速度，而不是必需的。

我知道macroslogging器喜欢使用它，但一切都可以引用，而不使用select。

简单的例子：

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

可以被replace为：

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

此代码正在努力将标记为“是”的“获奖”列的过滤数据复制到另一张表。

 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 

结果：

主数据表：

ActiveJobStatus表：