Importar TXT a Excel Ancho Fijo

Te anexo una macro para importar un archivo txt

Sub Macro2()
'Por Dante Amor
'Importar Archivo txt
    '
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = Sheets("Hoja7")        'nombre de la hoja donde se va a importar
    ruta = "c:\trabajo\"            'carpeta
    arch = "archivo1.txt"           'nombre del archivo
    '
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
    If Dir(ruta & arch) = "" Then
        MsgBox "No existe el archivo"
        Exit Sub
    End If
    '
    Workbooks.OpenText _
        Filename:=ruta & arch, _
        Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(35, 1), Array(100, 1), Array(129, 1), _
        Array(150, 1), Array(170, 1), Array(200, 1)), TrailingMinusNumbers:=True
    Set l2 = ActiveWorkbook
    Set h2 = l2.Sheets(1)
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    h2.Rows("1:" & u2).Copy h1.Range("A" & u1)
    l2.Close False
    Application.ScreenUpdating = True
    MsgBox "Arhivo importado"
End Sub

Cambia en la macro los siguientes datos por tus datos

    Set l1 = ThisWorkbook
    Set h1 = Sheets("Hoja7")        'nombre de la hoja donde se va a importar
    ruta = "c:\trabajo\"            'carpeta
    arch = "archivo1.txt"           'nombre del archivo

Realiza una prueba con un archivo.

Si quieres que se importen varios archivos, debes explicar en dónde están los archivos y a dónde se va a poner la información de cada archivo.

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 

estaba usando de momento el siguiente 

Sub Import_TXT_Anchofijo()
'Definimos variables a utilizar
Dim Filtro As String
Dim nFichero As Integer
Dim sCadena As Variant
Dim i As Double
nFichero = FreeFile
'indicamos que tipo de archivo que vamos a seleccionar (txt)
Filtro = " TXT(*.TXT),"
'buscamos el archivo
txt = Application.GetOpenFilename(Filtro)
'si existe fichero comenzamos la instrucción, de lo contrario el proceso no se 'inicia
If txt <> Empty Then
'mediante un bucle do while recorremos todas las líneas de información del txt
Open txt For Input As nFichero
i = 0
Do While Not EOF(nFichero)
Line Input #nFichero, datos
i = i + 1
sCadena = datos
'definimos la longitud del ancho de cada información e indicamos en que columna se 'debe insertar
'la fila ya viene determinada con la longitud del fichero txt (i) que hemos 'definido al principio
'con la función Mid indicamos los campos a extraer y la con la función Trim 'eliminamos espacios en blanco
'que se nos puedan haber olvidado por error.
With Sheets(1)
.Cells(i, 1) = (Mid(sCadena, 1, 35))
.Cells(i, 2) = (Mid(sCadena, 136, 20))
.Cells(i, 3) = (Mid(sCadena, 156, 22))
.Cells(i, 4) = (Mid(sCadena, 176, 21))
End With
Loop
'por último cerramos el proceso.
Close nFichero
End If
End Sub

en la que me envias como modifico para anexar las hojas cuando son varios txt y disculpa, la ruta donde estan los txt es:  C:\Users\grhcrl.FLORESTA\Desktop\FAOV\NOMINAS QUINCENALES EMPLEADOS\JUNIO\       y quiero que se vacien en la hoja 6,7,8  y 9 ya que en esta carpeta son 4 txt

Como te dije:

Realiza una prueba con un archivo.

Si quieres que se importen varios archivos, debes explicar en dónde están los archivos y a dónde se va a poner la información de cada archivo.

Si puedes explicarlo con ejemplo e imágenes sería mejor.

Buenos días Dante me funciona excelente la macro que me envías, como te decía la ruta o el patch donde están los TXT es:

C:\Users\grhcrl.FLORESTA\Desktop\FAOV\NOMINAS QUINCENALES EMPLEADOS\JUNIO\

En esta carpeta existen cuatro txt, la ruta la iría cambiando a medida que valla generando las extracciones y estos txt se deben extraer en el archivo base cada uno en una hoja diferente del libro

Va la macro actualizada

Sub Macro2()
'Por Dante Amor
'Importar Archivo txt
    '
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = Sheets("Hoja7")        'nombre de la hoja donde se va a importar
    ruta = "c:\trabajo\"            'carpeta
    ruta = "C:\Users\grhcrl.FLORESTA\Desktop\FAOV\NOMINAS QUINCENALES EMPLEADOS\JUNIO\"
    '
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
'    If Dir(ruta & arch) = "" Then
'        MsgBox "No existe el archivo"
'        Exit Sub
'    End If
    arch = Dir(ruta & "*.txt")           'nombre del archivo
    '
    Do While arch <> ""
        Workbooks.OpenText _
            Filename:=ruta & arch, _
            Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
            FieldInfo:=Array(Array(0, 1), Array(35, 1), Array(100, 1), Array(129, 1), _
            Array(150, 1), Array(170, 1), Array(200, 1)), TrailingMinusNumbers:=True
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
        h2.Rows("1:" & u2).Copy h1.Range("A" & u1)
        l2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Arhivo importado"
End Sub

¡Gracias!, funciona excelente igual que la anterior solo que me extrae todos los TXT en la misma hoja que selecciono, habría forma de que los extraiga en hojas diferentes?