Sub My()
Dim fn As String, r&, N&
Dim Arr(), My_Path_File
My_Path_File = ThisWorkbook.Path
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 Dim fs As New FileSystemObject
    Dim Fl As Folder
    Dim f As File
      Dim Wb As Workbook
  
With ThisWorkbook
     fn = Dir(My_Path_File & "\*.xls*")
     Do Until fn = ""
    If Not fn Like "[#]*" And fn <> ThisWorkbook.Name Then
            Set Wb = GetObject(My_Path_File & "\" & fn)
            Arr = Wb.Worksheets(1).UsedRange.Value
            Windows(fn).Visible = True
            Set Wb = Nothing
            With Workbooks(fn)
                .Save
                .Close
          End With
            If N = 0 Then
                .Worksheets(1).UsedRange.Offset(1).ClearContents
            End If
            N = N + 1
            If UBound(Arr) Then
                With .Worksheets(1)
                    r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(r, 1).Resize(UBound(Arr), 5) = Arr
                End With
            End If
        Replase_Fale_Name fn, Wb, My_Path_File
    End If
    fn = Dir
 Loop
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If N Then
        MsgBox " " & N & " вайлов проверена."
Else
    MsgBox "Нет новых файлов."
End If
End Sub

Dim b As Workbook
Dim fn As String, r&, N&
Dim Arr(), My_Path_File, My_Path_File1
My_Path_File = ThisWorkbook.Path
My_Path_File1 = ThisWorkbook.Path
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 Dim fs As New FileSystemObject
    Dim Fl As Folder
    Dim f As file
      Dim Wb As Workbook
With ThisWorkbook
     
     fn = Dir(My_Path_File & "\*.txt*")
     Set b = Workbooks.Open(Filename:=My_Path_File & "\" & fn, UpdateLinks:=0)
     On Error Resume Next
     b.SaveAs My_Path_File & ".xls"
     b.Close savechanges:=True

......

End With
...    
End Sub

Dim b As Workbook
Dim fn As String, r&, N&
Dim Arr(), My_Path_File
My_Path_File = ThisWorkbook.Path
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 Dim fs As New FileSystemObject
    Dim Fl As Folder
    Dim f As file
      Dim Wb As Workbook
With ThisWorkbook
     
     fn = Dir(My_Path_File & "\*.txt*")
     Set b = Workbooks.Open(Filename:=My_Path_File & "\" & fn, UpdateLinks:=0)
     'On Error Resume Next
     b.SaveAs My_Path_File & "\" & fn & ".xlsx"
     b.Close savechanges:=True
     
     Do Until fn = ""
    If Not fn Like "[#]*" And fn <> ThisWorkbook.Name Then
            Set Wb = GetObject(My_Path_File & "\" & fn)
            SortWorkshit Wb
            Arr = Wb.Worksheets(1).UsedRange.Value
            Naruschiteli Arr, Wb
            Windows(fn).Visible = True
            Set Wb = Nothing
            With Workbooks(fn)
                .Save
                .Close
          End With
            If N = 0 Then
                .Worksheets(1).UsedRange.Offset(1).ClearContents
            End If
            N = N + 1
            If UBound(Arr) Then
                With .Worksheets(1)
                    r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                    .Cells(r, 1).Resize(UBound(Arr), 5) = Arr
                End With
            End If
        Replase_Fale_Name fn, Wb, My_Path_File
    End If
    fn = Dir
 Loop
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
If N Then
        MsgBox " " & N & " файлов проверена."
Else
    MsgBox "Нет новых файлов."
End If
End Sub

Set Wb = GetObject(My_Path_File & "\" & fn)
            SortWorkshit Wb
            Arr = Wb.Worksheets(1).UsedRange.Value
            makros1 Arr, Wb
            Windows(fn).Visible = True