多个工作簿的表合并到一个工作簿中多张表 表名=工作簿名

501888521

想求一段代码。如附件一个文件夹中有多个工作簿，每个工作簿属于不同的业务人员，代码实现的功能是：
把各个业务人员的工作簿里边sheet1的内容合并到  “总表”中。
最后总表工作簿中包括每个业务人员的表，表名就是业务人员的工作簿的名字。

谢谢！

xiaohuaxiong

这个多工作簿合并的帖子很多啦，搜一下就知道了

501888521

朱荣兴 发表于 2015-11-5 17:05

谢谢，
代码测试有一个问题，每运行一次都会多生成一个空表出来

501888521

朱荣兴 发表于 2015-11-5 17:05

Set sh = ThisWorkbook.Sheets.Add(Sheets(Sheets.Count))
在这一步的时候会生成一个空表

autumnalRain

1. Sub Sql复制()
   
2. Set Cnn = CreateObject("adodb.connection")
   
3.     Filename = Dir(ThisWorkbook.Path & "\*.xls")
   
4.     Do While Filename <> ""
   
5.       If Filename <> ThisWorkbook.Name Then
   
6.         SHEETNAME = Split(Filename, ".")(0)
   
7.         ThisWorkbook.Worksheets.Add.Name = SHEETNAME
   
8.         Cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=NO;imex=1';Data Source=" & ThisWorkbook.Path & "" & Filename
   
9.         Sql = "select F1,F2 from  [sheet1$]"
   
10.         Sheets(SHEETNAME).[a65536].End(3).CopyFromRecordset Cnn.Execute(Sql)
    
11.         Cnn.Close
    
12.       End If
    
13.         Filename = Dir
    
14.     Loop
    
15.     Set Cnn = Nothing
    
16. End Sub

复制代码

501888521

autumnalRain 发表于 2015-11-6 13:54

十分感谢 这个方法是最简单的。
能有请您帮忙再改进一下。有两个地方
我在附件里边附带的所有的文件。
1. 您的代码在用的时候，只能把每个文件的前两列 粘贴汇总表中。能不能有多少列粘贴多少列，并且保留各表的格式？
2. 代码在运行一次之后，汇总表里边会生成几个新表。可不可以改成 我在第二次运行的时候，除去汇总表以外第一次生成表都会被删除，然后重新生成。这样就可以实现直接刷新的功能了，而不需要手动删除了。
目前的代码我再第二次运行 的时候会提示错误。如图