Looping In VBA Please help

[shelim481]

I Have the below VBA code but i cant get it to loop every time, until "rFound" is noting, also how do i change "Const FlName" so that it would save in the same file directoy as the xlsm file but everytimes it loops i want the txt file it creates to change its name in consecutive order e.g. chunk 1.txt, chunk 2.txt?
and once "rFound" is noting i want it to say complete work...

[/COLOR][COLOR=#333333]Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

Sub Findexpand()
    Dim rFound As Range
    Dim FCell As String
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Test")
    Dim k As Long
    Dim tmpFile As String
    Dim MyData As String, strData() As String
    Dim entireline As String
    Dim filesize As Integer
    Dim Test As Boolean

    On Error Resume Next
    Set rFound = Cells.Find(What:="*", _
                    After:=Cells(Rows.Count, Columns.Count), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    
   On Error GoTo 0
    
     If rFound Is Nothing Then
        

        MsgBox "Noting found"
       
         Else
    
    
    FCell = rFound.Address(RowAbsolute:=False, ColumnAbsolute:=False, External:=False)
    k = sh.Range(FCell, sh.Range(FCell).End(xlDown).End(xlDown).End(xlUp)).Rows.Count
    ActiveSheet.Range(FCell).Select
    Selection.Resize(numRows + k, numColumns + 50).Select
    Selection.Cut
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Paste
    
    '~~> change this to orginal file location
    Const FlName = "C:\Users\Desktop\Chunk1.txt"

    '~~> Create a Temp File
    tmpFile = TempPath & Format(Now, "ddmmyyyyhhmmss") & ".txt"

    ActiveWorkbook.SaveAs Filename:=tmpFile _
    , FileFormat:=xlText, CreateBackup:=False

    '~~> Read the entire file in 1 Go!
    Open tmpFile For Binary As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    MyData = Space$(LOF(1))
    Get [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , , MyData
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    strData() = Split(MyData, vbCrLf)

    '~~> Get a free file handle
    filesize = FreeFile()

    '~~> Open your file
    Open FlName For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filesize]#filesize[/URL] 

    For i = LBound(strData) To UBound(strData)
        entireline = Replace(strData(i), """", "")
        '~~> Export Text
        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filesize]#filesize[/URL] , entireline
    Next i

    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filesize]#filesize[/URL] 
    Application.DisplayAlerts = False

    'Worksheets(Worksheets.Count).Activate
    'ActiveSheet.Delete
    'Application.DisplayAlerts = True

   
'   Kill tmpFile

    End If
  MsgBox "Done"
     
    </code>[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]