Sub MultiLineCells()
Dim firstRow As Long
Dim srcSht As Worksheet
Dim outSht As Worksheet
Dim srcRng As Range
Dim cRow As Range
Dim cntLfRef_A As Long
Dim cntLfRef_B As Long
Dim outLastRow As Long
Set srcSht = Worksheets("Sheet1")
Set outSht = Worksheets("Sheet2")
firstRow = 6
Set srcRng = srcSht.Cells(firstRow, "A").CurrentRegion
Set srcRng = srcRng.Offset(1, 0).Resize(srcRng.Rows.Count - 1) ' Resize without heading row
outLastRow = outSht.Cells(Rows.Count, "A").End(xlUp).Row
For Each cRow In srcRng.Rows
'do Ref_A or Ref_B have more than line feed character
cntLfRef_A = Len(cRow.Cells(1, 5)) - Len(Replace(cRow.Cells(1, 5), vbLf, ""))
cntLfRef_B = Len(cRow.Cells(1, 6)) - Len(Replace(cRow.Cells(1, 6), vbLf, ""))
If cntLfRef_A <> 0 Or cntLfRef_B <> 0 Then
' Perform copy of row
outLastRow = outLastRow + 1
cRow.Copy Destination:=outSht.Cells(outLastRow, "A")
End If
Next cRow
End Sub
[/COD
[/QUOTE]
It's exactly what i needs. Thanks you so much.
can I ask you 1 more favour?
If I want to paste the data in the same sheet right after the original data, is it possible?