Sub TXT()
Dim 此表, 新表
oPath$ = "C:\AAA"
Set 此表 = ActiveSheet
T$ = Dir(oPath & "\" & [A1] & "*")
Do While T <> ""
Set 新表 = Sheets.Add(after:=Sheets(Sheets.Count))
新表.Name = Split(T, ".")(1)
With Workbooks.Open(oPath & "\" & T)
.Sheets(1).UsedRange.Copy 新表.[A1]
.Close False
End With
T = Dir
Loop
此表.Activate
End Sub