copy & paste using looping

[jane5]

Sub dataloop()
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To Lastrow
If Cells(i, 3) = "Pass" Then
ActiveCell.Offset(-4).Copy
ActiveCell.Offset(2, -2).PasteSpecial
End If


Next i


End Sub

I am trying to use looping to copy and paste the value where C= Pass, then go up 4 rows and copy and paste into 2 rows down and 2 rows left, from cells containing Pass. However, It's not woking as I what need it to do. It gives me errors, and I do not know how to fix this...

Is there any solution for this?

 

[Derek73]

Try:

Sub dataloop()
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To Lastrow
If Cells(i, 3) = "Pass" Then
Cells(i, 3).Offset(-4, 0).Copy
Cells(i, 3).Offset(2, -2).PasteSpecial
End If


Next i


End Sub
More elegantly, use a with:

Sub dataloop()
Dim Lastrow as Long
Lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For i = 4 To Lastrow
   With Cells(i,3)
      If .Value = "Pass" Then
         .Offset(-4,0).Copy
         .Offset(2, -2).PasteSpecial
      End If
   End With
Next i


End Sub