title: Copy found result under the current row
body: <p>So I am having a worksheet with 16 columns. And I would like to find out the cells with font color is vbRed. Lets say Range("A5") is the found cell then I would like to copy and paste the entire row into the next row in the current worksheet. </p>
  
  <p>As I am writing Macro, I found my program will keep looping on the row that I copied and pasted. And also I am not sure whether I can use loop, copy and paste together with find method. I will strong appreciate if anyone can help with this.</p>
  
  <p>With my current code:</p>
  
  <pre><code>Sub CopyRow()
  
  Dim Row As Long
  Row = ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlDown)).Rows.Count
  Sheets("Sheet1").Activate
  Dim rng As Range
  Set rng = Range("A1:A" &amp; Row)
  
  For Each cel In rng
  If cel.Font.Color = vbRed Then
  cel.Rows.EntireRow.Insert Shift:=xlDown
  cel.EntireRow.Copy cel.Offset(-1).EntireRow
  cel.Offset(1, 0).Select
  End If
  Next cel
  
  End Sub
  </code></pre>
  
  <p>There's infinite loop....</p>