[xpost][/xpost]
Currently, my excel sheet is composed of data that are not in long format. [Blocked Image: https://i.stack.imgur.com/48pNi.png]
I want to cut the data to paste at the bottom of the first 2 columns to get something like this:
[Blocked Image: https://i.stack.imgur.com/6FerU.png]
I have written some vba code to allow me to do the cutting and pasting. However, the code doesn't seem to exit the Find Loop and continuously finds and cuts. I want to stop finding after all columns after the 1st 2 are cut and pasted to the bottom. What edits can I make to the code to allow the find to escape the loop? Thank you
Code
Sub FindTextInSheets()
Dim FirstAddress As String
Dim myColor As Variant
Dim rng As Range
Dim Corp As Range
Dim rowscount As Variant
Dim rowsno As Integer
Set rng = ActiveSheet.Cells.Find(What:="Code", _
After:=Range("B1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
rng.Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Set rng = ActiveSheet.Cells.FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
End Sub
[attach=1232546][/attach]