一键汇总多表数据成总表，并保留源表格式

嗨，大家好，我是星光。

之前咱们分享过一段VBA小代码，作用是将多个工作表的数据汇总成总表，但那段代码并没有保留原工作表的格式。在实际工作中，有些朋友是需要保留源表格式的。

以下代码在将各工作表数据汇总的同时，也保留了源表格式。

Sub CollectDataFromShtFormat()
    Dim sht As Worksheet, rng As Range, k As Long, nTitleCount As Long
    On Error Resume Next
    nTitleCount = Val(InputBox('请输入标题的行数', '提醒', 1))
    If nTitleCount < 0 Then MsgBox '标题行数不能为负数。', 64, '提示': Exit Sub
    Application.ScreenUpdating = False
    Cells.ClearContents '清空当前表数据
    For Each sht In Worksheets '遍历工作表
        If sht.Name <> ActiveSheet.Name Then
        '如果工作表名称不等于当前表名则进行汇总动作……
            Set rng = sht.UsedRange
            k = k + 1 '累计K值
            If k = 1 Then '如果是首个表格，则K为1，则把标题行一起复制到汇总表
                sht.Cells.Copy: Range('a1').PasteSpecial Paste:=xlPasteFormats '只粘贴格式
                rng.Copy: Range('a1').PasteSpecial Paste:=xlPasteValues '只粘贴数值
            Else '否则，扣除标题行后再复制黏贴到总表，只黏贴数值
                rng.Offset(nTitleCount).Copy
                With Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1)
                    .PasteSpecial Paste:=xlPasteFormats '粘贴格式
                    .PasteSpecial Paste:=xlPasteValues '粘贴数值
                End With
            End If
        End If
    Next
    Range('a1').Activate
    Application.ScreenUpdating = True '恢复屏幕刷新
    MsgBox '汇总OK，一共汇总了：' & k & '张工作表'
End Sub

动画演示效果如下：

代码三五行，工作不用忙断肠，你也试一下吧~