将多个工作簿中的一个 工作表合并到一个新工作表中

wwq_2012

求助各位大神：问题描述：将工资文件夹中 长春、韩尔滨、鸡西、沈阳等等工作簿中“店铺-最前面添加两列”工作表合并到“工资合并”工作簿的“sheet1”里，“小时工-最前面加两列”合并到“sheet2”里。

本人小白一枚，谢谢各位大大相助啦

zhaogang1960

ADO法速度较快，请参考:

1. Sub ADO法()
   
2.     Dim Fso As Object, File As Object, cnn As Object, rs As Object, SQL$, i&, j&, n&, arr, sh(1) As Worksheet
   
3.     Application.ScreenUpdating = False
   
4.     arr = Array("[店铺-最前面添加两列$]", "[小时工-最前面加两列$]")
   
5.     Set sh(0) = Sheets("Sheet1")
   
6.     Set sh(1) = Sheets("Sheet2")
   
7.     sh(0).Cells.ClearContents
   
8.     sh(1).Cells.ClearContents
   
9.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
10.     Set cnn = CreateObject("adodb.connection")
    
11.     For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
    
12.         If File.Name Like "*.xls" And File.Name <> ThisWorkbook.Name Then
    
13.             n = n + 1
    
14.             If n = 1 Then
    
15.                 cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & File
    
16.                 For i = 0 To 1
    
17.                     Set rs = cnn.Execute(arr(i))
    
18.                     For j = 1 To rs.Fields.Count
    
19.                         sh(i).Cells(1, j) = rs.Fields(j - 1).Name
    
20.                     Next
    
21.                     sh(i).Range("a2").CopyFromRecordset rs
    
22.                 Next
    
23.             Else
    
24.                 For i = 0 To 1
    
25.                     SQL = "select * from [Excel 12.0;Database=" & File & ";]." & arr(i)
    
26.                     sh(i).Range("a" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
    
27.                 Next
    
28.             End If
    
29.         End If
    
30.     Next
    
31.     rs.Close
    
32.     cnn.Close
    
33.     Set rs = Nothing
    
34.     Set cnn = Nothing
    
35.     Set Fso = Nothing
    
36.     Application.ScreenUpdating = True
    
37. End Sub
    

复制代码

zhaogang1960

请测试附件
工资.rar (176.68 KB, 下载次数: 50)

2016-1-12 15:02 上传

点击文件名下载附件

wwq_2012

zhaogang1960 发表于 2016-1-12 15:03
请测试附件

谢谢哥，感谢您的帮助~
除了真心说句谢谢，真不知道还能怎么感谢您

LMY123

ADO,同名工作表合并

补充内容 (2019-1-1 15:44):
同夹_多薄_多表_合并成一薄多表_ADO法,已入库。