Excel VBA - Search Range - If Cell Contains Text Then Copy Cell - Paste Offset 2,1

Question

I'm attempting to simplify an excel sheet I work with on a weekly basis.

I'm trying to create a VBA Macro that would do the following:

1. Search Column C for any Cells that contain Text, If Blank Ignore It
2. If text is found in a Cell, Copy That Cell, Paste the Contents Offset (2,1)

Any help anyone can give me, I would greatly appreciate. I have searched for other macros and have attempted to modify them for my use to no avail.

    **Example Before Macro**
  A       B       C       D       E
1                 Hi
2                 Test
3
4                 Done
5
6

**Example After Macro Has Been Run**
  A       B       C       D       E
1                 Hi
2                 Test
3                         Hi
4                 Done    Test
5
6                         Done

Current Code:

Sub CopyC()  
  Dim SrchRng As Range, cel As Range 
  Set SrchRng = Range("C1:C10") 

  For Each cel In SrchRng 
    If InStr(1, cel.Value) > 0 Then 
      cel.Offset(2, 1).Value = "-" 
    End If 
  Next cel 
End Sub

Answer 1

You are Close:

Sub CopyC()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("C1:C10")
For Each cel In SrchRng
    If cel.Value <> "" Then
        cel.Offset(2, 1).Value = cel.Value
    End If
Next cel
End Sub

I added 1-6 in column D to show that it is ignoring the blanks