Macros de n planillas de texto

Ok
Aca va otra vez todo:
Option Explicit
Private Const MAX_PATH = 64
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFind As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private TotSize As Long
Private NumSubdirs As Long
Private NumArxius As Long
Public TA As Long
Const MiDir As String = "C:\ARCHIVOS\"
Dim MATRIZ() As String
Dim NL As String
Sub pasar()
Dim i As Integer
On Error GoTo Err
ChDir MiDir
inf MiDir
If TA = 0 Then MsgBox "No se encontraron archivos en carpeta   " & MiDir, vbCritical: NL = "": Exit Sub
'If TA > ActiveWorkbook.Sheets.Count Then MsgBox "El total de Archivos TXT  supera al total de hojas disponibles en el libro actual", vbCritical: NL = "": Exit Sub
MATRIZ = Split(NL, "#")
Application.ScreenUpdating = False
For i = LBound(MATRIZ) + 1 To UBound(MATRIZ) - 1
     Call texto(1, MiDir & MATRIZ(i), MATRIZ(i))
DoEvents
Next
Err:  If Err.Number = 76 Then MsgBox "No se encontro la carpeta  " & MiDir
NL = ""
Erase MATRIZ
Application.ScreenUpdating = True
MsgBox "Terminado"
End Sub
Sub texto(hoja As Integer, ruta As String, archivo As String)
Dim t As Integer
    Sheets(hoja).Select
    [A65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
    If [A65536] = 0 Then
    [A65536].Value = 1
    Range("A" & [A65536].Value).Select
    t = [A65536].Value
    Else
    Range("A" & [A65536].Value + 1).Select
    t = [A65536].Value + 1
    End If
      With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ruta, Destination:=Range("$A$" & t))
        .Name = archivo
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    [A65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
    Range("AB" & t, "AB" & [A65536].Value) = archivo
    [A65536].Clear
End Sub
Private Function inf(miPath As String) As Long
    Dim atribarx As Long, TotSize As Long
    Dim valor1 As Long, valor2 As Long
    Dim InfoTd As WIN32_FIND_DATA
    Dim NomArxiu As String
    On Error Resume Next
    If Right(miPath, 1) <> "\" Then miPath = miPath & "\"
    TotSize = 0
    NumSubdirs = 0
    NumArxius = 0
    valor1 = 0
    valor2 = True
    valor1 = FindFirstFile(miPath & "*.*", InfoTd)
    Do
        NomArxiu = InfoTd.cFileName
        atribarx = InfoTd.dwFileAttributes
        If Left(NomArxiu, 1) <> "." Then
            If atribarx And FILE_ATTRIBUTE_DIRECTORY Then
                NumSubdirs = NumSubdirs + 1
            Else
                NumArxius = NumArxius + 1
            End If
        End If
        valor2 = FindNextFile(valor1, InfoTd)
    If valor2 > 0 Then NL = (NL & InfoTd.cFileName & "#")
    Loop Until valor2 = 0
    FindClose (valor1)
    DoEvents
    TA = NumArxius
    DoEvents
    DoEvents
    TotSize = 0
    NumSubdirs = 0
    NumArxius = 0
End Function