合并不同文件夹下相同名称的工作簿内的工作表到同一个工作表

lsc900707

yingkongwuyu 发表于 2016-12-25 20:08
老师好，如果在原始的excel中把sheet1工作表的名字改成了其他的，程序应该怎么进行更改呢？目的就是把文件 ...

这样问问题是不容易得到回答的，你向谁提问，要点他的楼层左下角的“回复”！

LMY123

合并子文件夹里的工作薄

补充内容 (2018-7-13 10:25):
合并多夹同名工作薄成一薄一表

补充内容 (2018-10-8 13:03):
Sub ADO法_同夹_同类工作薄_合并()
    Dim cnn As Object, rs As Object, SQL$, Fso As Object, Folder As Object, i&, j&, l&, wb As Workbook, d As Object, k, t, arr
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set d = CreateObject("scripting.dictionary")
    Set cnn = CreateObject("adodb.connection")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Folder = Fso.GetFolder(ThisWorkbook.Path & "\数据")
    Call GetFiles(Folder, d)
    Set wb = Workbooks.Add(xlWBATWorksheet)
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=excel 12.0;Data Source=" & ThisWorkbook.FullName
    k = d.keys
    t = d.items
    For i = 0 To d.Count - 1
        arr = Split(t(i), ",")
        With wb.Sheets(1)
            .Cells.ClearContents
            For j = 0 To UBound(arr)
                SQL = "select * from [Excel 12.0;Database=" & ThisWorkbook.Path & "\数据\" & arr(j) & "].[Sheet1$]"
                Set rs = cnn.Execute(SQL)
                If j = 0 Then
                    For l = 1 To rs.Fields.Count
                        .Cells(1, l) = rs.Fields(l - 1).Name
                    Next
                    .[a2].CopyFromRecordset rs
                Else
                    .Range("a" & .Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
                End If
            Next
            wb.SaveAs ThisWorkbook.Path & "\" & k(i)
        End With
    Next
    wb.Close
    Set Folder = Nothing
    Set Fso = Nothing
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

Sub GetFiles(ByVal Folder As Object, d As Object)
    Dim SubFolder As Object
    Dim File As Object
    For Each File In Folder.Files
        If File.Name Like "*.xlsx" Then
            If Not d.Exists(Split(File.Name, " ")(0)) Then
                d(Split(File.Name, " ")(0)) = File.Name
            Else
                d(Split(File.Name, " ")(0)) = d(Split(File.Name, " ")(0)) & "," & File.Name
            End If
        End If
    Next
End Sub

Jobiubiu

mark xiexixe~~~~~~~~~~~

starowen

zhaogang1960 发表于 2016-5-31 22:44
请参考：
Sub ADO法()
    Dim cnn As Object, rs As Object, SQL$, Fso As Object, Folder As Object, a ...

对不起，我这块真的一点都不明白……不会vba……

starowen

zhaogang1960 发表于 2016-5-31 22:47
请测试附件

您好，您这个附件我在别的帖子看过，我自己试用了一下，没有反应的……

starowen

zhaogang1960 发表于 2016-5-31 22:44
请参考：
Sub ADO法()
    Dim cnn As Object, rs As Object, SQL$, Fso As Object, Folder As Object, a ...

这个提示错误76

z601520274

lsc900707 发表于 2016-12-25 21:54
这样问问题是不容易得到回答的，你向谁提问，要点他的楼层左下角的“回复”！

http://club.excelhome.net/thread-1436329-1-1.html，老师帮忙看看哈

z601520274

LMY123 发表于 2017-6-17 10:38
合并子文件夹里的工作薄

补充内容 (2018-7-13 10:25):

http://club.excelhome.net/thread-1436329-1-1.html  老师帮忙看看