Sub CleanLoop4()
Dim NewName, SaveName, MyFile As String
Dim SavePath As String
MyPath = "C:\Temp\Trading\Files\"
SavePath = "C:\Temp\Trading\"
MyFile = Dir(MyPath & "*.txt")
' Starts the loop, which will continue until there are no more files
' found.
Application.DisplayAlerts = False
ChDir MyPath
Do While MyFile <> ""
Workbooks.OpenText FileName:= _
MyFile, Origin:=437, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
), Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1)), TrailingMinusNumbers:=True
NewName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
SaveName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name))
Rows("1:6").Select
Range("A2").Activate
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("C:J").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Columns("B:B").EntireColumn.AutoFit
Range("A:A").Select
X = ActiveSheet.UsedRange.Rows.Count
Range("C1").Select
ActiveCell.FormulaR1C1 = NewName
Range("C1").Select
Selection.Copy Destination:=Range("C1:C" & X)
Application.CutCopyMode = False
ActiveWorkbook.SaveAs SavePath & SaveName, FileFormat:=xlText, _
CreateBackup:=False
ActiveWorkbook.Close False
MyFile = Dir()
Loop
Application.DisplayAlerts = False
End Sub
Bookmarks