How do I search through a text file, rename it, move it, then move to the next one using VBA?

Sub FindFiles()
 
Columns("A:B").Select
Selection.Delete shift:=xlToLeft
 
Dim fs, f, f1, fc, s
Dim filenum As Long
Dim files As Range
 
Set fs = CreateObject("Scripting.filesystemobject")
Set f = fs.Getfolder("J:\Loans\Daily Activity Files\TestFolder\") 
Set fc = f.files
 
Range("A1").Select
 
For Each f1 In fc
     ActiveCell.FormulaR1C1 = f1.name           '"""" & f1.name & """"
     ActiveCell.Offset(1, 0).Select
Next
 
Columns("A:A").EntireColumn.AutoFit
Range("A1").Select
 
Rows("1:1").Select
    Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "FILES IN FOLDER"
    Range("B1").Select
    ActiveCell.Value = 0
Range("B2").Select
 
Do While ActiveCell.Offset(0, -1).Value <> ""
        ActiveCell.Value = 1 + ActiveCell.Offset(-1, 0).Value
        ActiveCell.Offset(1, 0).Select
Loop
        
filenum = ActiveCell.Offset(-1, 0).Value
Set files = Range("A2:A" & filenum)
 
Rows("1:1").Select
Selection.Delete shift:=xlUp
Columns("B:B").Select
Selection.Delete shift:=xlToLeft
 
Dim sFolderName, set_Path1, set_Path2, set_path3, set_path4 As String
Dim sFileName, sFileNameT, correctfolder, currfile, tempstring1, tempstring2 As String
Dim fso, f2
    
    set_Path1 = "J:\Loans\Daily Activity Files\TestFolder\"
    set_Path2 = "J:\Loans\Daily Activity Files\TestFolder\TSA\"
    set_path3 = "J:\Loans\Daily Activity Files\TestFolder\DCP\"
    set_path4 = "J:\Loans\Daily Activity Files\TestFolder\ORP\"
 
tempstring2 = "@UTGA"
    
For eachfile = 1 To filenum
     currfile = set_Path1 & Range("A" & eachfile).Value
     Open currfile For Input As #eachfile
       Do Until EOF(eachfile)
          Line Input #eachfile, tempstring1
             If tempstring1 Like "*" & "TSA" & "*" And InStr(1, tempstring1, tempstring2) Then
                  valuefound = "TSA"
                  'MsgBox (currfile & " = " & valuefound)
                ElseIf tempstring1 Like "*" & "457B" & "*" And InStr(1, tempstring1, tempstring2) Then
                  valuefound = "DCP"
                  'MsgBox (currfile & " = " & valuefound)
                ElseIf tempstring1 Like "*" & "ORP" & "*" And InStr(1, tempstring1, tempstring2) Then
                  valuefound = "ORP"
                  'MsgBox (currfile & " = " & valuefound)
                Else
                  valuefound = "Nothing"
             End If
       Loop
     Close #eachfile
     Set fso = CreateObject("scripting.FileSystemObject")
        If valuefound = "TSA" Then
                correctfolder = set_Path2
            ElseIf valuefound = "ORP" Then
                correctfolder = set_path3
            ElseIf valuefound = "DCP" Then
                correctfolder = set_path4
            Else
                MsgBox ("There were no indicators found for " & Range("A" & eachfile).Value)
        End If
     On Error Resume Next
     sFileNameT = Right(correctfolder, 4)
     sFileName = Left(sFileNameT, 3) & eachfile & ".txt"
    Set f = fso.GetFile(currfile)
    f.Move (correctfolder & sFileName)
Next
Columns("A:A").Select
Selection.Delete shift:=xlToLeft
 
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94: