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

Question

I need to move data from one sheet to another by the criteria date, but the selection that I made using IF only select the last cell that matches that criteria.

Here is what i got so far:

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

Answer 1

You are finding them all, the problem is that every answer overwrites R56 on the other sheet. Here's code that advances that destination cell every repeat of the loop - and also avoids the bad practice of selecting and activating every sheet and cell you are working with:

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

Answer 2

I'm assuming you don't want to overwrite Sheets("Plan2").Range("r56") each time you find the value. If that's the case, this code writes the found value into the same row it is found on the first sheet.

This works without copy paste and selecting or activating cells / sheets. Also if you specify your sheet with the source data, like i did, it doesn't even matter which sheet you start the macro from.

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