将以下代码复制到你要合并的工作表VBA视窗，然后执行此代码
Sub CombineWorkbooksrange()
Dim FilesToOpen, ft
Dim x As Integer
Application.ScreenUpdating = False
On Error GoTo err
FilesToOpen = Application.GetOpenFilename("Excel文件（*.xls & *.xla & *.xlt *.xlsx *.xlsb）,*.xls;*.xla;*.xlt;*.xlsx;*.xlsb", MultiSelect:=True, Title:="要合并的文件")
If TypeName(FilesToOpen) = "boolean" Then
MsgBox "没有选定文件"
GoTo err
End If
x = 1
While x - 1 < UBound(FilesToOpen)
Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
For i = 1 To wk.Sheets.Count
Set xlra = wk.Sheets(i).Range("a1:z1")
'注意，引号内的1就是你要的相同工作表名,如果工作表名无要求，则继续，取单元格数值，现在是取a1:z1
Sheet1.Range("a65500").End(xlUp).Offset(1, 0) = wk.Name
xlra.Offset(0, 0).Resize(xlra.Rows.Count, xlra.Columns.Count).Copy Sheet1.Range("a65500").End(xlUp).Offset(1, 1)
Next
x = x + 1
wk.Close
Wend
MsgBox "合并成功完成！"
err:
End Sub
只是得每个文件的文件名称呢，怎么把文件的第一行提取出来放在其文件名后面呢？
追答A列是文件名，B列开始是各文件第一行的内容，选中多少个文件，提取多少文件内容，你执行过没有？
追问执行过了，A列是文件名，但是B列的内容都是/kml，选中了4443个文件
追答你看看工作表中第一行第一个单元格是啥内容？不要一下选好多，选两三个文件执行一下，查查符不符合你的要求，不符合截个屏说明一下。
追问工作表第一行第一、第二个单元格是空的，如截图二那样。运行的结果是图一。需要的是把图二第一行J列单元格放到每个文件名称的后面
只需获得工作表中J1单元格么？
把代码改成这样
Set xlra = wk.Sheets(i).[j1]
'注意，引号内的1就是你要的相同工作表名,如果工作表名无要求，则继续，取单元格数值，现在是取a1:z1
Sheet1.Range("a65500").End(xlUp).Offset(1, 0) = wk.Name
Sheet1.Range("a65500").End(xlUp).Offset(0, 1) = xlra
Next
仔细看了一下原代码，发现写入定位有问题，也可以改成
xlra.Offset(0, 0).Resize(xlra.Rows.Count, xlra.Columns.Count).Copy Sheet1.Range("a65500").End(xlUp).Offset(1, 1)中的Offset(1, 1)改为Offset(0, 1)
sub 宏1()
dim st,p,f,i
set st=activesheet
p="c:\temp\"'上千个文件所在的文件夹，必须以\结尾
f=dir(p & "*.xls?")
while f<>""
i=i+1
st.cells(i,1)=f
with workbooks.open (p & f)
.sheets(1).range("a1:z1").copy st.cells(i,2)
.close
end with
f=dir
wend
end sub
你好
怎么实现把几千个Excel文件里第一行和文件名称提取到一个表格里？
追答私信帮写
本回答被提问者采纳特定的数据有什么特征？追问
都是文件里的第一行
追答方法1、VBA
方法2、PowerQuery
方法3、一行行复制粘贴
方法4、交给秘书