按日期复制和粘贴数据-excel vba

我需要在条件日期之前将数据从一个工作表移动到另一个工作表，但我使用的选择仅选择与该条件匹配的最后一个单元格

以下是我到目前为止得到的信息：

Sub Copiar()

Dim range1 As Range

Set range1 = Range("k56:k58")

For Each cell In range1
   If cell.Value = Range("R55").Value Then
      cell.Offset(0, 2).Select
      Selection.Copy
      Sheets("Plan2").Activate
      Range("r56").Select
      ActiveSheet.Paste
   End If
Next

End Sub

---

你找到了所有答案，问题是每个答案都会覆盖另一张纸上的R56。下面的代码可在循环的每次重复中推进目标单元格，并避免选择和激活正在使用的每个工作表和单元格的错误做法：

Sub Copiar()  
Dim range1 As Range, destin as Range  
Set range1 = Range("k56:k58")
Set destin= Sheets("Plan2").Range("r56")  
For Each cell In range1
   If cell.Value = Range("R55").Value Then
      cell.Offset(0, 2).copy destin
      set destin=destin.offset(1,0)    ' Crucial bit here
   End If
Next  
End Sub

---

我假设您不希望每次找到值时都覆盖

工作表（“Plan2”）.Range（“r56”）

。 如果是这种情况，则此代码将找到的值写入第一页上找到的同一行

无需复制粘贴和选择或激活单元格/工作表即可执行此操作。 此外，如果您像我一样使用源数据指定工作表，那么从哪个工作表启动宏都无关紧要

Sub Copiar()

Dim range1 As Range
Set range1 = Sheets(1).Range("K56:K58")

For Each cell In range1
   If cell.Value = Sheets(1).Range("R55").Value Then
        Sheets("Plan2").Range("R" & cell.Row).Value = cell.Offset(0, 2).Value
   End If
Next

End Sub

（1） 您需要阅读如何避免选择（2）您需要阅读添加图纸参考（3）您每次粘贴到同一单元格R56的内容。