1分钟拆解:如何将10多张工作表sheet,合并成一张?

article_cover

又到了久违的VBA教学时间!


今天,解题宝宝无聊闲逛,惊奇发现了两份VBA代码,特意分享给大家。


是解决如何合并大量不同的工作表哒。


多少张都没问题!亲测有效!


分为以下两种情况👇




1 合并同一工作簿的不同工作表


效果长这样:


本来,同一工作簿下,一个排班表是一张sheet;



接下里,就变成:所有排班表汇总成一张sheet,格式还自动排好!


◎ 效果演示


厉害叭?


代码立即备上,宝宝们直接复制粘贴就好,操作无敌容易!



Step 1


  • 新建一个Sheet,鼠标右键选择  查看代码  。这时你打开了VBA界面。


◎ 操作演示



Step 2


  • 复制以下代码,粘贴进  模板  编辑框。


Sub 合并当前工作簿下的所有工作表()


Application.ScreenUpdating = False


For j = 1 To Sheets.Count


   If Sheets(j).Name <> ActiveSheet.Name Then


       X = Range("A65536").End(xlUp).Row + 1


       Sheets(j).UsedRange.Copy Cells(X, 1)


   End If


Next


Range("B1").Select


Application.ScreenUpdating = True


MsgBox "解题宝宝,我成功啦", vbInformation, "提示"


End Sub


◎ 复制进去后的样子



Step 3


  • 按  F5  调试,见证奇迹发生的时刻叭!


◎ 操作演示




2 合并不同工作簿的不同工作表


首先,你的所有工作簿,要放在同一个储存位置,同一个文件夹,


那下面介绍的操作才会生效哦。


比如解题宝宝的这三个工作簿,都在「考勤记录」文件夹。



这情况下,当我们想打开三份考勤记录,就不得不打开三个文件。



然而,经过解题宝宝的代码,你完全可以实现:三个考勤时间表归总到一个工作簿!


以前总是打开一大堆Excel文件,把电脑卡死?


以后再也不会存在呐!打开一个文件,就能查看所有工作簿。


◎ 效果演示



Step 1


  • 在同一文件夹里,新建一个  XLSL工作表 ,命名后打开它。


◎ 操作演示



Step 2


  • 点击Sheet1,像刚刚一样打开VBA界面,复制以下代码:


Private Sub hb()


    Dim hb As Object, kOne As Boolean, tabcolor As Long


    Set hb = Workbooks.Add


    Application.DisplayAlerts = False


    For i = hb.Sheets.Count To 2 Step -1


        hb.Sheets(i).Delete


    Next


     


    Dim FileName As String, FilePath As String


    Dim iFolder As Object, rwk As Object, Sh As Object


    Set iFolder = CreateObject("shell.application").BrowseForFolder(0, "请选择要合并的文件夹", 0, "")


    If iFolder Is Nothing Then Exit Sub


    FilePath = iFolder.Items.Item.Path


    FilePath = IIf(Right(FilePath, 1) = "\", FilePath, FilePath & "\")


    FileName = Dir(FilePath & "*.xls*")


    Do Until Len(FileName) = 0


        If UCase(FilePath & FileName) <> UCase(ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then


            Set rwk = Workbooks.Open(FileName:=FilePath & FileName)


            tabcolor = Int(Rnd * 56) + 1


            With rwk


                For Each Sh In .Worksheets


                    Sh.Copy After:=hb.Sheets(hb.Sheets.Count)


                    hb.Sheets(hb.Sheets.Count).Name = FileName & "-" & Sh.Name


                    hb.Sheets(hb.Sheets.Count).Tab.ColorIndex = tabcolor


                    If Not kOne Then hb.Sheets(1).Delete: kOne = True


                Next


                .Close True


             End With


        End If


        Set rwk = Nothing


        FileName = Dir


    Loop


    Application.DisplayAlerts = True


End Sub


◎ 复制进去后的样子


  •   F5  调试,选择你工作簿们所在的目录。


如果出现「包含外部链接」的提示,选择  更新 。


◎ 操作演示


大功告成!


你已经把同一文件夹目录的所有工作簿,


都引入了进来,统统变成工作表呐,随意切换查看呐。


◎ 效果演示



各位粉丝宝宝,

有什么不明白的Excel问题,

欢迎在下方评论区留言,

我会24小时内回复你哒。


如果觉得这篇文章帮到你,

请动动手指“分享”到朋友圈

转发给更多需要的好友呐。


最后,祝你早日成为Excel高手,

解题宝宝相信,你一定可以


4049人看过

评论 (13)

0/500
  • 别再说爱我

    最近看到很多python的广告,说是对工作汇报也有帮助。不知道能否实现跟文章中一样的功能呢?

    01-16 09:26
  • 心期千劫在

    居然只要一个代码就搞定了Σ(っ °Д °;)っ

    01-16 09:25
  • 衷于自己

    神器啊

    01-16 09:25
  • 我已长大不信童话

    代码收藏了,备用

    01-16 09:25
  • 让我成为你的有可能

    在我需要整理一年表格的时候看到这个,代码虽然看不懂,照做就对了

    01-14 19:19
  • 利用自己

    好像很厉害的样子

    01-14 16:08
  • 梦醒了你终究要离开

    从来没写过,很像写程序吼。

    01-13 15:23
  • 我的心如琥珀为你而割舍我的泪如宝石为你而闪亮

    干货满满

    01-10 14:39
  • 称霸天下拜我裙下

    哈哈哈,我一直都是用复制粘贴来完成的~~~

    01-09 15:44
  • 谎言在真不过谎言

    感谢小编

    01-07 09:22
  • Besilly

    Eccel还能这么用,太实用了,谢谢小编”

    01-04 12:18
  • 唱着情歌流着泪

    这个技能很实用,不过代码已看晕

    01-03 12:41
  • 怎知冷暖

    这个也太方便了吧!!!马住!!!

    01-02 16:40
没有更多评论啦~
Skill成长学院
办公生产力研究所