将行复制到具有多个范围的多个条件的另一个工作表VBA Excel中

我试图复制行从一个表到另一个使用VBA，我需要它来检查列中的单元格，如果它包含值X，如果列C排除值Y.

我已经尽可能地复制了第一个标准，但不是第二个标准。

这是我的，它不会工作…

Sub Copy_2016() ' 'Run Sub Copy_2016() ' Sheets("Working - 2016").Select Range("A3:AO6304").ClearContents For Each Cell In Sheets("Working - Data").Range("A1:A6304,C3:C6304") If Cell.Value = "2016" And If Not Cell.Value = "HI" Then matchRow = Cell.Row Rows(matchRow & ":" & matchRow).Select Selection.Copy Sheets("Working - 2016").Select ActiveSheet.Rows(matchRow).Select ActiveSheet.Paste Sheets("Working - Data").Select End If Next End Sub 

Answer 1

有一件事@chris neilsen的答案是缺less的，是粘贴的工作表（“工作-2016”）将在中间有空行（因为不是所有的行都将被复制），这就是为什么我添加RowDestvariables。

此外，如果您只需粘贴这些值，则可以使用Worksheets("Working - 2016").Rows(RowDest).value = Cell.EntireRow.value而不是在2代码行中Copy和Worksheets("Working - 2016").Rows(RowDest).value = Cell.EntireRow.value 。

码

 Option Explicit Sub Copy_2016() Dim Cell As Range Dim RowDest As Long With Worksheets("Working - 2016") .Range("A3:AO6304").ClearContents End With RowDest = 3 ' first paste row , since you are clearing the sheet's contents With Worksheets("Working - Data") For Each Cell In .Range("A1:A6304") If Cell.value Like "2016" And Not Cell.Offset(0, 2).value Like "HI" Then Worksheets("Working - 2016").Rows(RowDest).value = Cell.EntireRow.value RowDest = RowDest + 1 End If Next Cell End With End Sub 

Answer 2

我想你需要这样的东西

 Sub Copy_2016() Dim Cell As Range Worksheets("Working - 2016").Range("A3:AO6304").ClearContents For Each Cell In Worksheets("Working - Data").Range("A1:A6304") If Cell.Value = "2016" And Not Cell.Offset(0, 2).Value = "HI" Then Cell.EntireRow.Copy Worksheets("Working - 2016").Rows(Cell.Row).PasteSpecial Paste:=xlPasteValues End If Next End Sub