Loop to End

[mgujaran]

The loop should stop when it reach at the bottom of the file (not stopping at Bold query) but it is looping.


Sub Macro1()
'
' Macro1 Macro
' Macro recorded by Mahesh
'
'
ChDir "G:\Mahesh1\Client Compliance Report\DP AML\CDSL reports\Feb11"
Application.WindowState = xlNormal
Workbooks.OpenText Filename:= _
"G:\Mahesh1\Client Compliance Report\DP AML\CDSL reports\Feb11\ISIN from diff ac to one ac2.txt" _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
False, Comma:=False, Space:=False, Other:=False, OtherChar:="-", _
FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Cells.Find(What:="TrxDate", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.Copy
Workbooks.Add
Dim NewBk As String
NewBk = ActiveWorkbook.Name
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select
Windows("ISIN from diff ac to one ac2.txt").Activate
ActiveCell.Offset(5, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(NewBk).Activate
ActiveSheet.Paste
Range("A65536").End(xlUp).Offset(1, 0).Select
Do
Windows("ISIN from diff ac to one ac2.txt").Activate
Cells.Find(What:="TrxDate", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, _
MatchCase:=False, SearchFormat:=False).Activate
If Range("A1:A65536").End(xlUp).Value = "PrintDate" Then Exit Do
ActiveCell.Offset(2, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(NewBk).Activate
ActiveSheet.Paste
Range("A65536").End(xlUp).Offset(1, 0).Select
Windows("ISIN from diff ac to one ac2.txt").Activate
Loop
End Sub