所有sheet合并成一页_1分钟拆解:如何将10多个工作表sheet,合并成一张?

由Skill成长学院原创出品

作者:解题宝宝

编辑:乌妹妹

ad620a2aede5d2b67239cd307bafc372.png

 Excel  ·  基础必备  ·  高效率  ·  懒癌必备 

⏱1mins                 ?有作业

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

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

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

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

分为以下两种情况☟

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


效果长这样:

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

693234b3581d34e6a42404954b486c4b.gif

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

◎ 效果演示

32bc60bb7b390c229611d55f2fc4b99e.gif

厉害叭?

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

Step 1

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

◎ 操作演示

f09ba4da5402db45a5d228cd047f51dd.gif

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

◎ 复制进去后的样子

f70f0b15b91842c88df2c66769ad0a8c.png

Step 3

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

◎ 操作演示

0c784ed2b63cc06e6eff87a2bf61a8fb.gif

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


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

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

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

a4af0b9f4c7a5ef1fd43a9820b2f8673.png

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

a64c1a6b5864b9d5a988d6ee8c02d147.png

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

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

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

◎ 效果演示

ad6b3b36328c9ab718967f766078e09d.gif

Step 1

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

◎ 操作演示

c610e2ff5dc4758820b0f967d97eb61f.gif

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

◎ 复制进去后的样子

768e195ba7d2d1c56f7357abff8b1a01.png

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

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

◎ 操作演示

eb83fd6ea7ecc40db061bcb965f525bd.gif

大功告成!

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

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

◎ 效果演示

ad6b3b36328c9ab718967f766078e09d.gif

练手时间


因为今天教学的是VBA执行代码,

所以只给素材给大家,只要代码运行成功,就代表你的操作成功呐。

作业包里有两个Excel文件,一份排班表,一份考勤表。

  • 公众号后台敲「527」领取本期作业。

最后,各位粉丝宝宝提问的话,请到文章下方留言,或者连同把表格一起发到邮箱呐(向公众号输入「邮箱」即可获取邮箱地址)。

这样解题宝宝才更能看见、有了表格也更明白问题是啥。

祝晚上学习愉快!


收藏后,记得多回看才会掌握哒

-你的转发和分享f1afcc0a829f6979fc8f40f30b3609aa.png就是最好的鼓励-

8051ca48cb816937f5ea8fd381724074.png

skill成长课堂

一直陪你升职加薪

扫码关注我吧

「skill大大说,

多1个好看

今天就给我加鸡腿」↘

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值