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

Question

我正在尝试使用 VBA 将行从一个工作表复制到另一个工作表，我需要它来检查 A 列中的单元格是否包含值 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 答案是粘贴的工作表("工作 - 2016"(中间会有空白行(因为并非所有行都会被复制(，这就是我添加 RowDest 变量的原因。

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

法典

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