点击这里查看首页

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


来源:高中英语教学交流网
发布时间: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

相关文章
·excel里如何把一列多行等分成多列?07-13
·A4排版16开打印试卷 08-30
·快速增加共享打印机的代码05-17
·excel怎么生成随机数?02-03
·解决桌面IE图标或者我的电脑无法删除02-20
·如何让试题的ABCD选项对齐04-13
·免魔法使用 New Bing 新方案03-18
·十秒免工具激活windows 1002-25
·任务栏上的显示桌面图标不见了,怎么办?09-17
·在Word里用通配符实现特殊替换05-09
最新文章
·十秒免工具激活windows 1002-25
·批量替换word文档中的第一行作为文件的文件名06-21
·自动对一个文件夹下的N个word文件批量执行一个宏06-21
·Win10电脑开机启动慢?教你只需三步,电脑开机速度快06-11
·连接打印机时需要输入用户名密码怎么办?05-15
·免魔法使用 New Bing 新方案03-18
·Win10电脑账号密码设置、修改、取消12-06
·视频加速脚本TimerHooker (计时器掌控者)06-17
·[亲测有效]excel批量修改文件名10-29
·Excel随机生成区间数值06-23
阅读排行