如何将包含两个特定值的一列中的所有行复制到Excel上的另一张工作表

Question

我正在尝试从excel工作表（Sheet1）复制所有行，这些行具有从其他单元格引用的特定值。 然后将它们粘贴到新的工作表（Sheet2）中。 我的具体示例是我想复制在A列中具有“ 0”和/或“ 35”的行。但是，由于“ B6”和“ B7”中的内容，这些值可能会更改。 我遇到的问题是它仅复制包含来自“ B6”的值为0的行，而忽略了我想要“ B7”值为35的命令。 我的代码如下供参考

Sub Temp_copy()
set i = Sheets("Sheet1")
set e = Sheets("Sheet2")
Dim d
Dim j
d = 1
j = 2

Do Until IsEmpty(i.Range("A" & j))
If i.Range("A"&j) = Range("B6"&j) Then
d=d+1
e.Rows(d).Value=i.Rows(j).Value

End If

j = j+1
Loop

Do Until IsEmpty(i.Range("A" & j))
If i.Range("A"&j) = Range("B7"&j) Then
d=d+1
e.Rows(d).Value=i.Rows(j).Value

End If

j = j+1
Loop

End Sub

我是VBA的新手，因此非常感谢为实现我所需要的任何帮助或指导。

Answer 1

简单or运算符将帮助您完成此操作！

Sub Temp_copy()
Set i = Sheets("Sheet1")
Set e = Sheets("Sheet2")
Dim d
Dim j
d = 1
j = 2

Do Until IsEmpty(i.Range("A" & j))
    If i.Range("A" & j) = Range("$B$6") Or i.Range("A" & j) = Range("$B$7") Then
        d = d + 1
        e.Rows(d).Value = i.Rows(j).Value

    End If
j = j + 1
Loop

End Sub

Answer 2

您可以使用自动过滤器复制所需的数据，而不是遍历单元格，如下所示...

Sub CopyRows()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
dws.Cells.Clear
sws.AutoFilterMode = False
'Assuming Row1 is the Header Row on Sheet1
With sws.Range("A1:A" & lr)
    .AutoFilter field:=1, Criteria1:=sws.Range("B6").Value, Operator:=xlOr, Criteria2:=sws.Range("B7").Value
    .SpecialCells(xlCellTypeVisible).EntireRow.Copy
    dws.Range("A1").PasteSpecial xlPasteValues
End With
sws.AutoFilterMode = False
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub