excel vba 汇总多个文件数据

寻觅大师解惑：
我想要把多个文件的数据汇总到一个文件里，每个文件的数据形式是一样的。以下语句哪里有问题？老是需要调试。刚发现没有分了。大师们当做做好事儿吧！感激不尽！
Dim Y As Long
Y = [a65536].End(xlUp).Row + 1
Range("a2:f" & Y).ClearContents
Set Conn = CreateObject("adodb.Connection")
For x = 1 To 3
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "/" & x & "月.xls"
Sql = "select * from[" & x & "月$]"
[a65536].End(xlUp).Offset(1, 0).CopyFromRecordset Conn.Execute(Sql)
Conn.Close
Next x
Set Conn = Nothing

Sub aa()
'首先要引用 microsoft activex data objects...
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset

For I = 1 To 3
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=d:\" & I & "月.xls;" & _
"Extended Properties=""Excel 8.0;"""

rs.Open "Select * from [" & I & "月$]", cnn, adOpenKeyset, adLockOptimistic

If Worksheets("汇总").Range("a1") = "" Then
Worksheets("汇总").Range("a1") = rs.Fields(0).Name
Worksheets("汇总").Range("b1") = rs.Fields(1).Name
End If

n = Worksheets("汇总").Range("a65536").End(xlUp).Row
Worksheets("汇总").Range("a" & n + 1).CopyFromRecordset rs

rs.Close
cnn.Close
Next I

End Sub

大至就是这样了。

搞复杂了吧，不需要用ADO，直接filestoopen = Application.GetOpenFilename("Microsoft Office Excel Files (*.*), *.*", , "请选取Excel2003或Excel2007文件", , True)，然后循环一下，处理filestoopen

如果表格的格式一模一样 那么在总表里面（假设总表在最前一个表）选择要汇总的一个项 输入 =SUM( 之后点总表后面的那个表的标签 再按住SHIFT，点最后一个表的标签，再点最后一个表总的那个对应的单元格 再输入）回车 结果的形式为 =SUM(SHEET2:SHEET50!C4) 其他单元格的就直接复制这个单元格的公式粘贴过去（注意，不是复制上里面的内容，直接复制粘贴就可以了）。

这个很简单,你可以私信我,需要点时间. 你的excel什么版本,我的是2010,   还有个问题"读取某一个指定路径的文件夹下，所有excel文件的sheet1工作表里 （b2-b15）（d2-d9）的数据",共14+8个数据,"写入到当前工作表 的（f12列)和(h12列)",如何排布?   而且读完第一个文件后,再读下一个文件,所得数据放在哪里,放在第一个文件的数据下方吗?如何对齐?   sub removepackagetypefromips_foroldformat() dim str1 as string, str2 as string, xpath as string, xf() as string, exe as string, xi as integer, xstart as integer, xend as integer, temp as string, i as integer dim xlong as long, xtemp as string dim xcup(1 to 22) as string exe = activeworkbook.name xpath = inputbox("please input the folder you want to have a list:", "target folder", "d:\readexcelfile\1\") if xpath = "" then exit sub if right(xpath, 1) <> "\" then xpath = xpath & "\" 'xpath = "p:\public\product development\approved ips\automotive\" str1 = dir(xpath, vbhidden + vbsystem) redim preserve xf(1) xf(1) = str1 ' look at me i = 2 redim preserve xf(2) if str1 <> "" then     do         str2 = dir()         if str2 <> "" then         xf(i) = str2         i = i + 1         redim preserve xf(i)         else         exit do         end if     loop end if 'have a big cycle to write and remove package type application.displayalerts = false for xi = 1 to ubound(xf) - 1 doevents workbooks.open xpath & xf(xi), updatelinks:=0 'activeworkbook.sheet1.activate     for i = 1 to 14     xcup(i) = activeworkbook.activesheet.cells(i + 1, 2)     next     for i = 15 to 22     xcup(i) = activeworkbook.activesheet.cells(i - 13, 4)     next workbooks(xf(xi)).close (0) ' savechanges:=false application.displayalerts = true windows(exe).activate 'activeworkbook.activesheet.select     xstart = 2     do until cells(xstart, 6) = ""     xstart = xstart + 1     loop     for i = xstart to xstart + 13     cells(i, 6) = xcup(i - xstart + 1)     next     for i = xstart to xstart + 7     cells(i, 8) = xcup(i - xstart + 14)     next next end sub 放在thisworkbook代码区

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息