通过搜索功能可以查询本站的所有文章
网站首页 本站动态 资源共享 美文妙乐 教学教案 双语新闻 论文相关 辅助教学 教学软件 广东高考

合并当前目录下所有工作簿的全部工作

来源：高中英语教学交流网 发布时间：2019-01-10 10:18:00 查看次数：
内容提要：合并当前目录下所有工作簿的第一个工作表，且只保留一个表头

有时候需要合并多个分班表格，一般做法是一个一个复制粘贴，其实可以使用这种快捷的方法。

完整文件下载点击这里

VBA代码如下。


Sub 合并当前目录下所有工作簿的全部工作表()

    Dim MyPath, MyName, AWbName
    Dim Wb As Workbook, WbN As String, G As Long, Num As Long
    Application.ScreenUpdating = False
    MyPath = ActiveWorkbook.Path
    MyName = Dir(MyPath & "\" & "*.xls")
    AWbName = ActiveWorkbook.Name
    Num = 0
    Do While MyName <> ""
        If MyName <> AWbName Then
            Set Wb = Workbooks.Open(MyPath & "\" & MyName)
            Num = Num + 1
            With Workbooks(1).ActiveSheet
                If Num = 1 Then

                    'Wb.Sheets(1).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)

Wb.Sheets(1).UsedRange.Copy .Cells(1, 1)

                Else
                    Wb.Sheets(1).UsedRange.Offset(1, 0).Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
                End If
                WbN = WbN & Chr(13) & Wb.Name
                Wb.Close False
            End With
        End If
        MyName = Dir
    Loop
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & Num & "个工作薄的工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub
扫一扫使用手机浏览或分享本页
相关文章
最新更新
阅读排行
快速导航
关于我们
联系我们
关于本站
选项对齐
网址www.zshunj.cn
本站帮助
免责声明
QQ：312000504
广告说明
英语科组
邮箱：JUN@ZSHUNJ.CN
 微信公众号 站长微信
版权所有 2008-2019 高中英语教学交流网