Sub Macro9()
'
' Macro9 Макрос
'


'
    ThemeEffectScheme.PasteSpecial Format:="Текст", Link:=False, DisplayAsIcon _
        :=False
End Sub

Option Explicit
Sub Text_Exl()
Dim collFnames As New Collection
Dim fname$, itrek$, ikey
Dim book As Workbook, arr$()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
itrek = ActiveWorkbook.Path & "\"
fname = Dir(itrek & "*.txt")
If fname = "" Then Exit Sub
Do
    collFnames.Add fname, fname
    fname = Dir
Loop Until fname = ""
For Each ikey In collFnames
    arr = Split(ikey, ".")
    Workbooks.OpenText Filename:=itrek & ikey, DataType:=xlDelimited, _
    Space:=True, ConsecutiveDelimiter:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _
    Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), _
    Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), _
    Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), Array(19, 2))
    Set book = ActiveWorkbook
    With book
        .Sheets(1).Cells.EntireColumn.AutoFit
        .SaveAs Filename:=itrek & arr(0), FileFormat:=xlNormal
        .Sheets(1).Name = "text"
        .Close True
    End With
Next ikey
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub