copy and paste using offset vba

[jaik22]

Sub Move_CenterANDDepart()


 Dim rng As Range, cell As Range, del As Range
 Set rng = Intersect(Range("C:C"), ActiveSheet.UsedRange)
 For Each cell In rng
   If (cell.Value) = "Valid" _
 Then
       If del Is Nothing Then
          Set del = cell
       Else: Set del = Union(del, cell)
       End If
    End If
 Next cell
 On Error Resume Next
 del.Offset(-4).Copy
 del.Offset(2, -2).PasteSpecial

What this code does is find Valid and copy 4 up cells and paste 2 down and 2 left from cells that contains Valid.
However seems like copying works, but paste does not work at all.

Do you guys have any idea?

thank you

 

[JoeMo]

If del is multiple non-contiguous cells, you can't do a single copy/paste. In that case if you comment out the On Error Resume Next line, you will get an error message. Since you are looping through each cell in column C you could do the copy/paste on each found cell individually.

 

[jaik22]

Thanks for the tip JoeMo,

Is there any good way to copy/paste on each of cells?