如何将分表汇总到总表_汇总分表成总表，并保留源表格式？只需一键！

每天一篇Excel技术图文 微信公众号：Excel星球 NO.175-多表汇总 作者：看见星光  微博：EXCELers / 知识星球：Excel 嗨，大家好，我是星光。
之前分享过一段VBA小代码，作用是 将多个工作表的数据汇总成总表 ，但那段代码并没有保留原工作表的格式。在实际工作中，有些朋友是需要保留源表格式的。 动画演示效果如下： 以下代码，在将各工作表数据汇总的同时，也保留了源表格式，且复制即可使用。
如果你还不会使用VBA代码，参考教程：如何运行VBA代码？其实很简单 代码如看不全可以左右拖动..▼

Sub CollectDataFromShtFormat()    Dim sht As Worksheet, rng As Range, k As Long    Dim nTitleCount As Long, x As Long, shtA As Worksheet    On Error Resume Next    nTitleCount = Val(InputBox("请输入标题的行数", "提醒", 1)) '用户输入标题行行数，默认为1    If nTitleCount < 0 Then MsgBox "标题行数不能为负数。", 64, "提示": Exit Sub    Application.ScreenUpdating = False '取消屏幕刷新    Set shtA = Worksheets("我的汇总表") '指定放置汇总数据的工作表    If Err Then '如果当前工作簿不存在shtA则新建一张        Set shtA = Worksheets.Add        shtA.Name = "我的汇总表"    End If    shtA.Select    Cells.Clear '清空当前表数据    For Each sht In Worksheets '遍历工作表        If sht.Name <> ActiveSheet.Name Then '如果工作表名称不等于当前表名则进行汇总动作……            Set rng = sht.UsedRange '已用区域            k = k + 1 '计数器            If k = 1 Then '如果是首个表格，则K为1，则把标题行一起复制到汇总表                sht.Cells.Copy: Range("a1").PasteSpecial Paste:=xlPasteFormats '保留格式                rng.Copy Range("a1")            Else '否则，扣除标题行后再复制黏贴到总表                x = Cells.Find("*", _                    LookIn:=xlFormulas, SearchOrder:=xlByRows, _                    SearchDirection:=xlPrevious).Row + 1 '最后存在数据的行                rng.Offset(nTitleCount).Copy Cells(x, 1)            End If        End If    Next    Range("a1").Select    Application.ScreenUpdating = True '恢复屏幕刷新    MsgBox "汇总OK，一共汇总了：" & k & "张工作表"End Sub

白鹤亮翅，打完收工。

更多VBA常用小代码▼

关注本公众号=>

【菜单】=>【资源】=>【常用代码】

▎全方位系统学习Excel 下方 扫码加入 我的 Excel社群 ▎