I have set of data which I want to transpose from columns to rows.. the data has same 17 headers and 25 rows of data for different companies one after another in columns and I want the same to be transposed into rows..so first I am finding the starting column name with the identifiable text and then from that column I am selecting 16 columns to right and 25 rows down range to cut and paste data .i.e. to append in the last row of Column D. I want to run this in loop till the all the columns data in right is cut and pasted in the rows one below another...but I run the below code which I have so far, it gets stuck in loop..


Code:
Sub test()
Dim rng As Range
Dim cell As Range
Dim search As String
Dim lRow As Long
lRow = Cells(Rows.Count, 4).End(xlUp).Row + 1
Set rng = ActiveSheet.Columns("U:XFD")
search = "IS_AUDITOR"
Set cell = rng.Find(What:=search, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)

If cell Is Nothing Then
    Exit Sub
Else
Do While cell.Value <> ""
cell.Select
 Range(ActiveCell, ActiveCell.Offset(25, 16)).Cut
 Range("D" & lRow).Select
 ActiveSheet.Paste

End If
Loop
End Sub