Macro para abrir archivos

señores expertos como puedo adecuar esta macro para abrir todo los archivos txt de la carpeta

Sub archivos_datCAP()
'Por.DAM
'escondemos el procedimiento'
Application.ScreenUpdating = False
'rescatamos los datos de la carpeta traspaso y creamos hoja interfaz'
ChDir "D:\traspaso"
arch = Dir("*.txt")
Set h1 = Sheets.Add
ActiveSheet.Name = "interfaz"
Do While arch <> ""
uf = h1.Range("A1").SpecialCells(xlLastCell).Row + 1
Workbooks.OpenText _
Filename:=arch, _
origin:=xlMSDOS, _
startrow:=2, _
DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 2), _
TrailingMinusNumbers:=True
ActiveSheet.UsedRange.Copy h1.Cells(uf, "A")
ActiveWindow.Close
arch = Dir()
Loop

end sub