Necesito que al ejecutar una macro de importación de txt a excel me pregunte por la ruta donde se encuentran los archivos

Te regreso la macro con la modificación para que puedas seleccionar la carpeta. Cambia en la macro en esta línea

Const rutaOrigen As String = "C:\Users\"

La carpeta inicial, también puedes poner "C:\" para iniciar desde la raíz de C.

Sub Macro()
'Mod.Por.DAM
    Const rutaOrigen As String = "C:\Users\"
    Const rutaDestino As String = "C:\Users\TXITXITAS\Desktop\kk2\kk\"
    Dim miFichero As String
    Dim Rango As Variant
    '
    Set navegador = CreateObject("shell.application")
    carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, rutaOrigen).items.Item.Path
    If carpeta = "" Then Exit Sub
    carpeta = carpeta & "\"
    ChDir carpeta
    '
    '¿Existen archivos de extensión txt en la carpeta original?
    miFichero = Dir("*.txt")
    Rango = "A1"
    Do While miFichero <> ""
        MsgBox "Vamos a importar el Fichero: " & rutaOrigen & " --- " & miFichero
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
            rutaOrigen & miFichero, Destination:=Range(Rango))
            .Name = miFichero
            .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 = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
        Rango = Range("A" & Fila).Address
        'Otras Opciones
        'milibro = ActiveWorkbook.Name
        miFichero = Dir
    Loop
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Buenas!!!

Gracias por la respuesta pero.....ahora no me funciona la macro....

Lo que pasa es que la idea que necesito es que pueda abrir con la macro el explorador de carpetas y seleccionar dentro de una carpeta cualquiera (puede estar en c, d o un disco duro externo) los archivos que yo quiera que importe (no todos los archivos de la carpeta)

Ya corregí la macro para que seleccione todos los archivos de la carpeta que selecciones.

Sub Macro()
'Mod.Por.DAM
    Const rutaOrigen As String = "C:\Users\"
    Const rutaDestino As String = "C:\Users\TXITXITAS\Desktop\kk2\kk\"
    Dim miFichero As String
    Dim Rango As Variant
    '
    Set navegador = CreateObject("shell.application")
    carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, rutaOrigen).items.Item.Path
    If carpeta = "" Then Exit Sub
    carpeta = carpeta & "\"
    ChDir carpeta
    '
    '¿Existen archivos de extensión txt en la carpeta original?
    miFichero = Dir("*.txt")
    Rango = "A1"
    Do While miFichero <> ""
        MsgBox "Vamos a importar el Fichero: " & rutaOrigen & " --- " & miFichero
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
            carpeta & miFichero, Destination:=Range(Rango))
            .Name = miFichero
            .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 = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
        Rango = Range("A" & Fila).Address
        'Otras Opciones
        'milibro = ActiveWorkbook.Name
        miFichero = Dir
    Loop
End Sub

Ahora, la siguiente macro es para seleccionar varios archivos. Para seleccionar varios debes mantener la tecla Control presionada y dar click con el mouse a cada archivo.

Sub archivos()
'Mod.Por.DAM
    Dim Rango As Variant
    '
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione uno o varios archivos"
        .Filters.Clear
        .Filters.Add "archivos txt", "*.txt"
        .FilterIndex = 1
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path
        If .Show Then
            Rango = "A1"
            For Each ar In .SelectedItems
                With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
                    ar, Destination:=Range(Rango))
                    .Name = ar
                    .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 = True
                    .TextFileTabDelimiter = False
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = True
                    .TextFileOtherDelimiter = "|"
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
                Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
                Rango = Range("A" & Fila).Address
            Next
        End If
    End With
End Sub

¡Gracias! Perfecto!!!!!!

Es justo lo que necesitaba!!!

Soy nueva en esto así que no se exactamente si he valorado correctamente tu respuesta.....pero desde luego un 10!!!!!

Gracias de nuevo!!!!