如何将很多excel文件中符合条件的行合入一个sheet？

myword999

很多excel文件，现在想将这些文件中B列为 临沂分公司 的行都复制到一个新excel文件中，该如何操作呢？
用宏吗？ Desktop.zip (13.03 KB, 下载次数: 21)

2011-10-12 16:50 上传

点击文件名下载附件

zhaogang1960

请测试
Sub 宏1()
    Dim cnn As Object, SQL$, Mypath$, MyFile$, n&
    Set cnn = CreateObject("Adodb.Connection")
    Mypath = ThisWorkbook.Path & "\"
    MyFile = Dir(Mypath & "*.xlsx")
    Do While MyFile <> ""
        If MyFile <> ThisWorkbook.Name Then
            n = n + 1
            If n = 1 Then
                cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & Mypath & MyFile
                SQL = "select * from [Sheet1$a2:c1048576] where 城市='临沂分公司'"
            Else
                SQL = SQL & " union all select * from [Excel 12.0;Database=" & Mypath & MyFile & "].[Sheet1$a2:c1048576] where 城市='临沂分公司'"
            End If
        End If
        MyFile = Dir()
    Loop
    If n = 0 Then
        MsgBox "没有发现可以复制的文件！", vbInformation, "提示"
        Exit Sub
    End If
    ActiveSheet.UsedRange.Offset(2).ClearContents
    [a3].CopyFromRecordset cnn.Execute(SQL)
    cnn.Close
    Set cnn = Nothing
End Sub

wdx223

1，各分表格式一样
2，各分表处于关闭状态

myword999

wdx223 发表于 2011-10-12 17:55
1，各分表格式一样
2，各分表处于关闭状态

请问如果多了一列，表头是2行合并到一起的，你这个就报错了。
---------------------------
Microsoft Visual Basic for Applications
---------------------------
系统错误 &H80040E37 (-2147217865)。
---------------------------
确定   帮助   
---------------------------

该怎么办呢？
如附件所示
xx1.zip (32.69 KB, 下载次数: 14)

2011-10-13 10:49 上传

点击文件名下载附件

wdx223

经测试，在我的电脑上运行正常

myword999

wdx223 发表于 2011-10-13 11:16
经测试，在我的电脑上运行正常

            cnn.Execute("Select * from [" & rsd("Table_Name") & "A2:D1048576] where [城市]='" & [F2] & "'")

A2:C1048576，把C改成D就不行了

myword999

{:soso_e100:}

LMY123

Set rsd = cnn.openschema(20)