Copy and paste data by date - 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

(1) You need to read up on how to avoid Select https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?r=SearchResults&s=1|273.1102 (2) You need to read up on adding sheet references (3) You are pasting to the same cell, R56, each time. — SJR, Jan 17 '19 at 17:49

Roy Brander · Accepted Answer · 2019-01-18T05:22:57.150

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

score 0 · Answer 2 · answered Jan 17 '19 at 18:23

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

Copy and paste data by date - excel vba

2 Answers2