VBA跨工作簿多表数据汇总

excel初学者1.0

   在EXCElHOME看了很多篇关于跨工作簿的帖子，也自己尝试了好多遍，但依旧无法整出来（太过于新手[捂脸]）。这份表格最近一个礼拜需要整完，工作量大，自己编写的代码总是出现错误，希望大家可以帮帮忙！

1. Sub test()
   
2.   Dim cnn As New ADODB.Connection
   
3.   Dim rs As New ADODB.Recordset
   
4.   Dim sql As String
   
5.   Dim mybook$, mypath$, wjm$
   
6.   mypath = ThisWorkbook.Path & ""
   
7.   mybook = ThisWorkbook.FullName
   
8.   
   
9.   With cnn
   
10.     .Provider = "microsoft.jet.oledb.4.0"
    
11.     .ConnectionString = "extended properties=""excel 8.0;HDR=YES;"";data source=" & mybook
    
12.     .Open
    
13.   End With
    
14.   
    
15.   wjm = Dir(mypath & "*.xls")
    
16.   Do While wjm <> ""
    
17.     If wjm <> "工作簿汇总.xls" Then
    
18.       sql = sql & "union all select * from [Excel 8.0;Database=" & mypath & wjm & "].[工资表1$b4:l] where len(店铺名称)<>0 and 店铺名称<>'工作簿汇总' "
    
19.     End If
    
20.     wjm = Dir()
    
21.   Loop
    
22.   sql = Mid(sql, 4)
    
23.   rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
24.   With Worksheets("汇总表")
    
25.     .UsedRange.Offset(4, 0).Delete
    
26.     .Range("b5").CopyFromRecordset rs
    
27.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
28.     .Range("a3:a" & r).FormulaR1C1 = "=row()-2"
    
29.     .Range("a" & r + 1) = "合计"
    
30.     .Range(.Cells(r + 1, 6), .Cells(r + 1, 19)).FormulaR1C1 = "=SUM(R[" & 2 - r & "]C:R[-1]C)"
    
31.     With .Range("a1:m" & r + 1)
    
32.       .Borders.LineStyle = xlContinuous
    
33.       .HorizontalAlignment = xlCenter
    
34.       .VerticalAlignment = xlCenter
    
35.     End With
    
36.   End With
    
37.   rs.Close
    
38.   cnn.Close
    
39. End Sub

复制代码

KCFONG

see if help you

mxsw

高手！！！！！！