从多个tXt文件导入数据到excel中，如何修改VBA代码，选取不同的文件

这个你试试
Sub 导入数据()
'修改这几句为
for Y=1932 to 2010
a$="Connection:="TEXT;D:\data\ap" & cstr(Y) & ".txt"
With ActiveSheet.QueryTables.Add(a$, Destination:=Range("A1"))
.Name = "ap" & cstr(Y)

.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

'还有这句
next Y

End Sub

'按照你录制的代码更改，已验证可以直接使用
Public Sub dbhb()
Dim FilesToOpen
Dim x As Integer
'Sheets.Add.Name = "空表"

On Error GoTo ErrHandler
Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="MicroSoft txt文件(*.txt),*.txt", _
MultiSelect:=True, Title:="要合并的文件")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "没有选中文件"
GoTo ExitHandler
End If

x = 1

While x <= UBound(FilesToOpen)
sr = "TEXT;" & FilesToOpen(x)
Sheets.Add
With ActiveSheet.QueryTables.Add(Connection:=sr, _
Destination:=Range("A1"))
.Name = "ap1932"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

手机登陆：UBBUBB．cσm

楼上正解··