将多个EXCEL文件合并(组合)成多个SHEET的单文件 VBA方法 多表组合 图文

2016年10月15日15:15:26 评论 10,983 views
摘要

我们要把多个只有一张sheet的文件,合并成一个文件里多个sheet的样子

198元黄金VIP包含 站内所有资源免费+VBA175+基础408+代码助手VIP+Q群答疑+
点我打赏升级VIP 教程淘宝购买链接 加微信EXCEL880A 课领取所有教程7天免费试学 教程所有目录excel880.com/mulu

请问如何把同一文件夹的所有工作簿合并到一个文件里,每个工作簿成为一个工作表

前面讲过了一个文件里【多个sheet拆分成为多个单独文件】的方法,这里再讲一讲逆向操作,就是我们要把多个只有一张sheet的文件,合并成一个文件里多个sheet的样子,如下图所示

要完成上述效果,如果用手工,有几十上百的表的话 还是挺费劲,不过还好咱们有万能的Excel神器-VBA,我用VBA写了一个小工具 ,可以非常快速的完成这种操作

VBA教程请点击 https://item.taobao.com/item.htm?id=597656284129

Private Sub bookMerge(path)
'  "本工具将组合当前目录下所有工作簿的第一个表到一个新文件中"
'*****http://excel880.com/
    Dim fs, f, f1, fc, s
    Dim wk As Workbook, sht As Worksheet
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(path)
    Set fc = f.Files
    Set targetWk = Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\组合.xlsx"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For Each f1 In fc '遍历文件夹文件
        If f1.Name <> ThisWorkbook.Name And f1.Name Like "*.xls*" And f1.Name <> "组合.xlsx" Then
            Set wk = Workbooks.Open(path & "\" & f1.Name) '打开工作簿
            Set sht = wk.ActiveSheet
                If ThisWorkbook.Sheets("x").Range("B2") = 1 Then
                    sht.Name = Mid(wk.Name, 1, InStrRev(wk.Name, ".") - 1)
                End If '改sheet名同文件名
                sht.Copy After:=Workbooks("组合.xlsx").ActiveSheet
            wk.Close
        End If
    Next
    targetWk.Save
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    'ThisWorkbook.Close SaveChanges:=True
    'MsgBox s
End Sub

Public Sub 多表合一()
    MsgBox "欢迎使用多表合一工具1.0" & Chr(13) & "made by Excel880 QQ80871835" & Chr(13) _
      & "本工具将组合当前目录下所有工作簿的第一个表到一个新文件中"
    bookMerge ThisWorkbook.Sheets("x").Range("B1")
End Sub

  • 微信扫码免费学习
  • 免费学习48小时
  • weinxin
  • 我的微信公众号
  • EXCEL880
  • weinxin