VBA复制工作表中的行，如果符合条件，则将其粘贴到其他工作表中

Question

我当前正在尝试将数据从一个工作表复制到另一个工作表中。如果“ QJ投资组合”工作表的F或G或H列中的日期介于工作表“存档”的单元格B1和D1中的日期之间。 为此，我正在使用此代码，这里看到1稍作修改。 问题在于它只是复制每一行，而我不明白为什么。

Sub Archive()
   Dim LastRow As Long
   Dim i As Long, j As Long
   Dim DFrom As Date
   Dim DTo As Date

   DFrom = Worksheets("Archive").Cells(1, 2).Value
   DTo = Worksheets("Archive").Cells(1, 4).Value

   'Find the last used row in a Column: column A in this example
   With Worksheets("QJ Portfolio")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   MsgBox (LastRow)
   'first row number where you need to paste values in Sheet1'
   With Worksheets("Archive")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With

   For i = 1 To LastRow
       With Worksheets("QJ Portfolio")
           If .Cells(i, 6).Value >= DFrom & .Cells(i, 6).Value <= DTo Or         
.Cells(i, 7).Value >= DFrom & .Cells(i, 7).Value <= DTo Or .Cells(i, 8).Value >= DFrom & .Cells(i, 8).Value <= DTo Then
               .Rows(i).Copy Destination:=Worksheets("Archive").Range("A" & j)
               j = j + 1

           End If
       End With
   Next i
End Sub

Answer 1

您似乎已经混淆了if语句。 请尝试以下方法。

    Sub Archive()
Dim LastRow As Long
Dim i As Long, j As Long
Dim DFrom As Date
Dim DTo As Date

DFrom = Worksheets("Archive").Cells(1, 2).Value
DTo = Worksheets("Archive").Cells(1, 4).Value

'Find the last used row in a Column: column A in this example
With Worksheets("QJ Portfolio")
 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

MsgBox (LastRow)
'first row number where you need to paste values in Sheet1'
With Worksheets("Archive")
  j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

For i = 1 To LastRow
   With Worksheets("QJ Portfolio")
       If (.Cells(i, 6).Value >= DFrom And .Cells(i, 6).Value <= DTo) And (.Cells(i, 7).Value >= DFrom And .Cells(i, 7).Value <= DTo) And (.Cells(i, 8).Value >= DFrom And .Cells(i, 8).Value <= DTo) Then
           .Rows(i).Copy Destination:=Worksheets("Archive").Range("A" & j)
           j = j + 1

       End If
   End With
Next i
End Sub