如果满足条件，VBA 从工作表复制行并将其粘贴到不同的工作表中答案

【问题标题】：VBA to copy row from worksheet and paste it into a different worksheet if criteria is met如果满足条件，VBA 从工作表复制行并将其粘贴到不同的工作表中
【发布时间】：2019-03-05 21:33:58
【问题描述】：

我目前正在尝试将数据从工作表复制到另一个如果工作表“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

【问题讨论】：

这是获取您不理解的代码并将您的标准添加到其中的问题。 If .Cells(i, 6).Value >= DFrom & .Cells(i, 6).Value <= DTo 没有通过脚本返回你想要的值 F8 并找出发生了什么
您需要逻辑上的And 而不是If...End If 中的& 符号&。

标签： excel vba copy

【解决方案1】：

您似乎混淆了您的 If then 语句。请尝试以下操作。

    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

【讨论】：