按日期复制和粘贴数据-Excel VBA

时间:2019-01-17 17:41:48

标签: excel vba

我需要在标准日期之前将数据从一张纸移到另一张纸,但是我使用IF所做的选择只能选择与该标准匹配的最后一个单元格。

这是我到目前为止所得到的:

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

2 个答案:

答案 0 :(得分:2)

您正在全部找到它们,问题是每个答案都会覆盖另一张纸上的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

答案 1 :(得分:0)

我假设您不想在每次找到该值时覆盖Sheets("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