Como hacer que extraiga los datos de los siguientes notepads al mismo tiempo y elegir la ruta que aparezca para elegir notepads

H o l a:

Te anexo el código. Pon tu archivo con la macro en la misma carpeta donde estarán los 8 notepad y ejecuta la macro.

La macro leerá todos los archivos txt y solamente considerará los que terminen en A, B, C, D, F, G o H

Sub LeerNotePad2()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    ruta = l1.Path & "\"
    arch = Dir(ruta & "*.txt")
    '
    lets = Array("A", "B", "C", "D", "E", "F", "G", "H")
    cols = Array("C", "H", "C", "H", "C", "H", "C", "H")
    fils = Array(9, 9, 24, 24, 39, 39, 54, 54)
    Do While arch <> ""
        letra = Mid(arch, Len(arch) - 4, 1)
        arr = ""
        For i = LBound(lets) To UBound(lets)
            If letra = lets(i) Then
                arr = i
                Exit For
            End If
        Next
        If arr <> "" Then
            col = Columns(cols(arr)).Column
            fil = fils(arr)
            Set l2 = Workbooks.Open(ruta & arch)
            Set h2 = l2.Sheets(1)
            Set r = h2.Columns("A")
            Set b = r.Find("Ch.", lookat:=xlPart)
            If Not b Is Nothing Then
                ncell = b.Address
                Do
                    dato1 = Split(h2.Cells(b.Row + 1, "A"), ",")
                    dato2 = Split(h2.Cells(b.Row + 2, "A"), ",")
                    h1.Cells(fil, col + 1) = dato1(1)
                    h1.Cells(fil, col + 2) = dato1(3)
                    h1.Cells(fil, col + 3) = dato2(1)
                    h1.Cells(fil, col + 4) = dato2(3)
                    fil = fil + 1
                    Set b = r.FindNext(b)
                Loop While Not b Is Nothing And b.Address <> ncell
            End If
            l2.Close
        End If
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Proceso terminado", vbInformation, "LEER ARCHIVOS"
End Sub

‘

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

Lo que pasa es que no solo habrá esos notepads, habrá 8 notrpads con una serie 123456789123 y cambiaran las letras finales, habrá muchos paquetes de 8 notepad, solo cambiara la serie entre cada paquete, pero las letras finales serian las mismas, hay alguna forma en wue yo pueda seleccionar los 8 notepads, otra es que como la serie de los 8 notepads sera la misma, que los filtre por la serie (123456789123) y los acomode por la letra final A, B, C,D, E, F, G, H, que al ejecutar la macro me pida la serie, busque los notepads y los acomode por au letra final, y se me complica tenerlos en la misma direccionos los notepads y excels ya que estancen la carpeta de puros notepads a donde los asogna la maquina

Lo más práctico es que tengas una carpeta dedicada para los 8 notepads. Borres los que tengas. Copies los 8 notepads de la carpeta origen y los pegues en la carpeta dedicada. Ya que los tienes en la carpeta, entonces ejecutas la macro.

Se puede hacer todo lo que pides.

1. Que la macro te abra el explorador y entonces selecciones una carpeta, por defecto te pondría una carpeta, y de ahí puedes seleccionar la carpeta que quieras.

2. Que pongas el número de serie en una celda de la misma hoja o en otra hoja; entonces la macro leería esa serie y únicamente abriría los archivos de esa serie con la terminación de las 8 letras.

¿Qué te parece?

Si estás de acuerdo, valora esta respuesta y crea la pregunta respectiva y empiezo a trabajar en la actualización de la macro.