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

Question

I am currently trying to copy data from a worksheet into another If the dates in the columns F or G or H from the sheet "QJ Portfolio" are between the dates in the Cells B1 and D1 of the sheet "Archive". To do so, I am using this code seen here 1 slightly modified. The problem is that it's just copying every row and I can't understand why.

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

It looks like you've confused your If then statement. Try the following.

    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