快速合并200个Excel工作簿

win2009

本想把论坛里的一个工作簿里的vba代码导入到自己的工作簿，搞了半天没成功（我是菜鸟），后来想能否用别的办法把他合并过来，在网上还真早到了，合并之后删除自己不要的工作表，代码保留下来，好高兴，转过来大家分享一下



快速合并200个Excel工作簿2009-04-06 22:06
       你会不会有大量Excel工作簿需要合并到一起呢？你可以手动完成这一工作，但这个工作可能会花费你一整天的时间。要完成合并工作，最好使用宏，这样只需花几分钟便可搞定。本文所介绍的技巧将向你说明如何创建这样一个宏，看看如何使用宏来节省你的宝贵时间。(本技巧可应用于Microsoft Excel 97、Excel 2000、Excel 2002、和Excel 2003。)
       这些工作簿总数约有200，保存在同一文件夹中，其中大多数工作簿中只包含一个单独的工作表，但有些工作簿包含多个工作表。这些工作簿中的工作表需要被添加到一个新的工作簿中。
       合并数量如此巨大的工作簿的最简单方法——如果经常要这样做的话——是使用宏。下面的宏会显示一个对话框，提示你选择要合并的文件。(你可以通过按下Ctrl键单击的方法选择多个工作簿。)它会使用代码在你所选的工作簿列表中循环，打开每个工作簿并将其中的工作表移动到工作簿的末尾。

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename(FileFilter: = "MicroSoft Excel文件(*.xls),*.xls",MultiSelect: = True,Title: = "要合并的文件")

    If TypeName(FilesToOpen) = "Boolean" then
        MsgBox "没有选中文件"
        Goto ExitHandler
    end if

    x = 1
    While x <= UBound(filestoopen)
        Workbooks.Open fileName: = filestoopen(x)
        Sheets().Move After: = ThisWorkbook.Sheets (ThisWorkbook.Sheets.Count)
        x = x + 1
    Wend
ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

（宏代码应写在第一张工作表中，而不是thisewordbood)

在将工作表添加到工作簿末尾的过程中，Excel会复制工作表的名称并自动根据检测结果附加(2)、(3)等数字编号。工作簿中与其他工作表相关的任何公式也会自动更新的新的名称。

yuannc

复制后 一点反应也没有

hxl-1

看看

ysese

看来需要花费点时间学习学习  VBA

ynkm001

大哥，好像真的除了把表打开，没有什么动静呀。是不是我哪里用错了，请教，请教。

飞云楼主

代码收下试下，谢谢了。

5128977

不会用啊，呵呵

wx65251206

好像不能实现吧，晚上来琢磨下~~

liujun

先收了，慢慢消化

大哥阿飞

学习代码了！