Thanks ctrlaltdel.
But it won't work for me. I have a huge data and multiple columns with such data. I need to copy the value from each cell in different row. I tried the below macro
Sub Extract()
Dim row_count As Long
Dim values As String
Windows("01122007-VP3TestCoverage.csv").Activate
row_count = 2
While Range("C" & CStr(row_count)).Value <> vbEmpty
Windows("01122007-VP3TestCoverage.csv").Activate
values = Range("C" & CStr(row_count)).Value
While Len(values) > 0 'test for multiple KRT IDs
values = add_KRTID(values, row_count)
Wend
row_count = row_count + 1
Wend
End Sub
Private Function add_Additional(kValue, row_count)
Range("C" & CStr(row_count)).Select
Selection.Cells.EntireRow.Copy 'for copy and paste functionality
Windows("Test.xls").Activate
' Selection.Cells.EntireRow.Insert
If (Asc(kValue) <> 10) Then
Range("C" & CStr(row_count)).Value = kValue
row_count = row_count + 1
End If
Windows("01122007-VP3TestCoverage.csv").Activate
End Function
Private Function add_KRTID(values As String, row_count As Long)
'Dim pos, count As Integer
Dim KRT As String
pos = InStr(1, values, Chr(13), vbBinaryCompare)
If (pos = 0) Then
pos = InStr(1, values, ";", vbTextCompare)
End If
If (pos > 0) Then 'found another KRTID add row
KRT = Left(values, pos - 1)
values = Trim(Replace(values, values, Right(values, Len(values) - pos)))
Call add_Additional(KRT, row_count)
Else 'last KRT ID or one KRT ID
Range("A" & CStr(row_count)).Value = values
values = "" 'remove last KRT ID
End If
add_KRTID = values
End Function
But I have one problem i.e the data is seperated by Alt + Enter then I am not able to get that value. I tried to use ASC function some regular expression but it is giveing me an error.
Can you help me on this
Thanks
Shriswaroop