如何用VBA汇总同一文件下多个工作薄

liulang0808

附件内容供参考。。。。。。

adm0795

liulang0808 发表于 2019-10-23 21:08
附件内容供参考。。。。。。

谢谢您！   

adm0795

liulang0808 发表于 2019-10-23 21:07
Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

非常感谢您的帮助！数据汇总出来是对的。

donghui2363

Sub 汇总()
Dim cnn, sql$
Dim ws As Worksheet
Dim arr(1 To 10)
Set ws = ThisWorkbook.ActiveSheet
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
    a = InputBox("输入工作表名")
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\" & a & ".xlsm"
    Set rs = cnn.OpenSchema(20)
    Do Until rs.EOF
        If rs.Fields("TABLE_TYPE") = "TABLE" Then
            s = Replace(rs("table_name").Value, "'", "")
            If Right(s, 1) = "$" Then
                k = k + 1
                arr(k) = rs("table_name").Value
            End If
        End If
        rs.movenext
    Loop
    ReDim brr(1 To k)
    For i = 1 To k
        m = m + 1
        brr(m) = arr(i)
    Next i
    Set rs = Nothing
For i = 1 To k
    r = ws.Range("a65536").End(xlUp).Row + 1
    x = brr(i)
    sql = "select * from[" & x & "]"
    Set rs = cnn.Execute(sql)
    ws.Range("a" & r).CopyFromRecordset rs
Next i
Set rs = Nothing
Set cnn = Nothing
End Sub

adm0795

donghui2363 发表于 2019-10-25 12:44
Sub 汇总()
Dim cnn, sql$
Dim ws As Worksheet

感谢帮助！！