Вставить данные на лист из нескольких txt

Sub Собрать_txt_данные_из_CurDir()
    ' разделитель данных символ "|"
    Dim i&, j&, N&
    Dim TextLine$, MyPath$, MyFileName$
    Dim M As Variant
    MyPath = CurDir & "\"
    MyFileName = Dir(MyPath & "*.txt")
    i = 0
    Do Until MyFileName = ""
        Open MyPath & MyFileName For Input Lock Read As #1
        Do While Not EOF(1)
            Line Input #1, TextLine
            M = Split(TextLine, "|", , vbTextCompare)
            N = UBound(M, 1)
            If N > -1 Then
                i = i + 1
                With ActiveSheet
                    .Range(.Cells(i, 1), .Cells(i, N+1)).NumberFormat = "@"
                    For j = 0 To N
                       .Cells(i, j+1) = M(j)
                    Next j
                End With
            End If
        Loop
        Close #1
        MyFileName = Dir
    Loop
End Sub

Dim appXL, sPath
With CreateObject("WScript.Shell").Exec("cmd /c copy *.txt all_txt.xls")
  Do While .Status = 0
     WScript.Sleep 100
  Loop
End With
 
sPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")) & "all_txt.xls"
 
On Error Resume Next
Set appXL = GetObject(,"excel.application")
If Err Then
  Set appXL = CreateObject("excel.application")
  appXL.Visible = True
End If
appXL.Workbooks.OpenText sPath, 2, 1, 1, 1, False, False, False, False, False, True, "|"

            Line Input #1, TextLine
            TextLine = StrConv(TextLine, vbFromUnicode)