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

Question

此代码正在复制＆＃34; Award＆＃34;的过滤数据。列标有＆＃34;是＆＃34;另一张纸;但是，我收到的错误是＃34; Type Mismatch。＆＃34;我现在不是100％，因为代码正常运行以过滤数据并正确复制。我目前有23行测试数据，以确保正常功能。如果我只放一行数据，那么它就不能正确复制和粘贴数据。我留下了复制的第一行数据加上第二行空数据。此外，它不会在粘贴后清除行的内容，因此我可以在日期进度中添加新数据。

＆＃13;

＆＃13;

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

＆＃13;

＆＃13;

＆＃13;

Answer 1

很抱歉让您的代码更改，但看起来您可能会过度复杂化。

这是我回答的上一个问题中的一些代码，只要找到“总计”一词，有人想要突出显示特定范围。

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

此外，为了将来参考，选择应该使用[几乎从不]。

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

我知道宏录制器喜欢使用它，但所有内容都可以在不使用select的情况下引用。

简要示例：

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

可以替换为：

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

<强>结果：

MasterData Sheet：

ActiveJobStatus表：