（如果复制）多个变量

Question

我想将数据从一张表复制到另一张表。选择部分是根据日期和列的具体值。

enter image description here

我从互联网上尝试了这段代码。所以基本逻辑是如果满足 2 个条件然后复制该行。但是它不起作用。

当只写一个条件时它实际上首先工作，当写第二个条件时，VBA没有做任何事情

Sub CopyRowsAcross()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Clean_Sheet")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Daily_Report")

For i = 2 To ws1.Range("P65536").End(xlUp).Row
    If ws1.Cells(i, 1) = "DOWNY S.FRESH 900ML"  and ws2.Range ("C2") = ws1.Cells(i,3) Then
    ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
    End If
Next i
End Sub

ws2.Range("C2") 被选中的日期写在工作表的单元格 C2 中。

结果是根据这 2 个条件复制的行

Answer 1

假设您在工作表 1 中的数据都是日期并且 C2 中的过滤器也是日期，则此方法有效：

Option Explicit
Sub CopyRowsAcross()

    Dim LastRow As Long, lrow As Long
    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Clean_Sheet")
    Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Daily_Report")
    Dim DateFilter As Date

    With ws2
        DateFilter = .Cells(2, 3)
        lrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With

    With ws1
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A1:C" & LastRow).AutoFilter Field:=1, Criteria1:="DOWNY S.FRESH 900ML"
        .Range("A1:C" & LastRow).AutoFilter Field:=3, Criteria1:=Format(DateFilter, "dd-Mmm-yy")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        If LastRow > 1 Then
            .Range("A2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy ws2.Cells(lrow, 1)
        End If
        .AutoFilterMode = False
    End With

End Sub

您可以只过滤所需的数据并一次性复制所有数据，而不是循环（耗时）。