Pasar Rango de datos de Excel a TXT

Buen día, he revisado varia preguntas de TODOEXPERTOS pero aun no consigo una que haga lo que necesito, la cuestión es, tengo una hoja en Excel necesito tomar un rango de datos y exportarlos o guardarlos como un archivo TxT. He trababajado en el siguiente codigo y quiciera pulirlo mas, en la presentacion de preguntas, donde lo va aguardar y en lo que me puedan ayudar:
'Sub GeneraTxt()
Dim MiRango As Range, Largo As Integer, FilaActual As Long
On Error Resume Next
Set MiRango = Application.InputBox("Seleccione rango a exportar a TxT", Type:=8)
On Error GoTo 0
If MiRango Is Nothing Then Exit Sub
fichero = ThisWorkbook.Name
ruta = ThisWorkbook.Path
Workbooks.Add
ChDir (ruta)
ActiveWorkbook.Close savechanges:=False
Open ruta & "\" & fichero & ".txt" For Output As #1
For Each Celda In MiRango
If Largo <= Len(Celda) Then Largo = 1 + Len(Celda)
Next Celda
FilaActual = MiRango.Cells(1).Row
For Each Celda In MiRango
If FilaActual < Celda.Row Then
FilaActual = Celda.Row: Print #1, ""
End If
Print #1, CStr(Celda); Space(1);
Next Celda
Close #1
Set MiRango = Nothing
End Sub