前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA汇总一个文件多工作表到一个表

VBA汇总一个文件多工作表到一个表

作者头像
哆哆Excel
发布2022-10-31 15:09:04
5010
发布2022-10-31 15:09:04
举报
文章被收录于专栏:哆哆Excel

VBA汇总一个文件多工作表到一个表

.

今天在工作中,同事传来一个excel文件中有很多个工作表,要我汇总,每个表的标题是一样的,虽然一个一个复制、粘贴是可以做到的,但时间很长,所以把以前学习一个代码,拿来用一下,代码找了很久才找到,想想还是把他放在这里好一点,以后查找方便

.

把多个工作表的内容汇总到一个“汇总”表中

代码语言:javascript
复制
Sub sheets_to_one()

    Dim mysht As Worksheet, rng As Range, sht As Worksheet

    Dim k

    ti = Timer()

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    

    Set mysht = ActiveSheet

    title_row = Val(Input("请输入标题行数", "提示"))

    If title_row < 0 Then

        MsgBox "标题行数不能为负数"

        Exit Sub

    End If

    mysht.Cells.ClearComments

    mysht.Cells.NumberFormatLocal = "@"

    k = 0

    For Each sht In Worksheets

        If sht.Name <> mysht.Name Then

            LastRow = mysht.Cells(Rows.Count, 1).End(xlUp).Row + 1

            Set rng = sht.UsedRange

            If k = 0 Then

                rng.Copy

                mysht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues

            Else

                rng.Offset(title_row).Copy

                mysht.Cells(LastRow, 1).PasteSpecial Paste:=xlPasteValues

            End If

            k = k + 1

        End If

    Next

    mysht.UsedRange.Borders.LineStyle = xlContinuous

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

    MsgBox "汇总了" & k & "个工作表" & Chr(13) & "用时:" & VBA.Round(Timer() - ti, 2) & "秒"

End Sub

效果:.

转载是一种动力 分享是一种美德

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2020-08-21,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 哆哆Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档