请问大神们，如何用VBA将30多个工作簿的内容进行合并筛选

1093137

如题：
请问大神们，如何用VBA将30多个工作簿的内容进行合并筛选，小弟目前有30个工作簿，每一个里面的内容抬头都是一模一样的，9月份每天的数据表，先需要将30天的工作簿的内容进行合并，请问如何使用VBA来解决，谢谢！

liulang0808

http://club.excelhome.net/thread-1258425-1-1.html
遍历文件资料供参考

LMY123

Sub ADO_汉字码_同夹多薄多表_合并()
    Application.ScreenUpdating = False
    Range("A2:Z1000") = ""
    路径 = ThisWorkbook.Path & "\分表\"
    外薄名 = Dir(路径 & "*.xlsx")
    Do While 外薄名 <> ""
        Set 连接 = CreateObject("ADODB.Connection")
        连接.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & 路径 & 外薄名
        Set 记录1 = 连接.OpenSchema(20)
        Do Until 记录1.EOF
            If 记录1.Fields("TABLE_TYPE") = "TABLE" Then
                外表 = Replace(记录1("TABLE_NAME").Value, "'", "")
                If Right(外表, 1) = "$" Then
                    SQL = "select 月份,出生地,学历,职位,数量 " _
& "from [Excel 12.0;DATABASE=" & 路径 & 外薄名 & "].[" & 外表 & "A1:F100] " _
& "order by 月份"
                    Set 记录2 = CreateObject("ADODB.recordset")
                    记录2.Open SQL, 连接, 1, 3
                    Range("A65536").End(3).Offset(1, 0).CopyFromRecordset 记录2
                End If
            End If
            记录1.MoveNext
        Loop
        外薄名 = Dir()
    Loop
    记录1.Close: Set 记录1 = Nothing
    记录2.Close: Set 记录2 = Nothing
    连接.Close: Set 连接 = Nothing
    Application.ScreenUpdating = True
End Sub

lsc900707

欢迎新会员！
没有附件很难有满意的解答！

1093137

lsc900707 发表于 2018-10-11 17:14
欢迎新会员！
没有附件很难有满意的解答！

附件的数据不能传出来，哎，心塞