vba 循环读取单元格_VBA实用小代码（十）：批量合并工作表Plus

看到这个标题，是不是感觉似曾相识？

没错，前一段时间，我写过一篇推文VBA实用小代码(三)，介绍的就是批量合并工作表。

但是，昨天自己处理数据的时候，发现还有值得优化的地方：

• 1.表尾去除功能。
• 2.合并之后的工作表可选择保留 or 不保留原格式。

具体细节请看动画： 代码如下： 提示：向左拖动可查看完整代码

Sub CollectSheets()    Application.ScreenUpdating = False    '取消屏幕更新，加快代码运行速度    Sheets(1).Select    If Sheets(1).Name = "DownGather" Then       Application.DisplayAlerts = False       Sheets(1).Delete       Application.DisplayAlerts = True    End If    Sheets.Add '新建一个汇总表    Sheets(1).Name = "DownGather"    Dim SHT As Worksheet, Rng As Range, k&, trow&, temp    temp = InputBox("请输入需要合并的工作表所包含的关键词(不区分大小写，不填默认全部合并)：", "提醒")    If StrPtr(temp) = 0 Then Exit Sub    '如果点击了inputbox的取消或者关闭按钮，则退出程序    trow = Val(InputBox("请输入表头的行数，不填默认保留表头", "提醒"))    drow = Val(InputBox("请输入表尾的行数，不填默认保留表尾", "提醒"))    If trow < 0 Then MsgBox "表头行数不能为负数", 64, "警告": Exit Sub    '取得用户输入的标题行数，如果为负数，退出程序    If drow < 0 Then MsgBox "表尾行数不能为负数", 64, "警告": Exit Sub    '取得用户输入的标题行数，如果为负数，退出程序    a = MsgBox("是否保留原格式？", vbYesNo)    If a = vbYes Then       b = xlPasteAll    Else       b = xlPasteValues    End If    For Each SHT In Worksheets    '循环读取表格        If SHT.Name <> ActiveSheet.Name Then        '如果表格名称不等于当前表名则……            If InStr(1, SHT.Name, temp, vbTextCompare) Then           '如果表中包含关键词则进行汇总动作(不区分关键词字母大小写)                Set Rng = SHT.UsedRange                '定义rng为表格已用区域                k = k + 1                '累计K值                If k = 1 Then                '如果是首个表格，则K为1，则把标题行一起复制到汇总表                    Rng.Copy                    [a1].PasteSpecial Paste:=b                Else                    '否则，扣除标题行后再复制黏贴到总表                    Rng.Offset(trow).Copy                    Cells(ActiveSheet.UsedRange.Rows.Count + 1 - drow, 1).PasteSpecial Paste:=b                End If            End If        End If    Next    [a1].Activate    '激活A1单元格    Application.ScreenUpdating = True    '恢复屏幕刷新End Sub

不懂 VBA ？没关系，只要学会复制代码运行就 OK ，参考推文： VBA实用小代码(一) 小贴士：

▎1.个人建议处理数据的时候还是不保留原格式比较好，可以减少一些隐藏的错误。

▎2.由于限制，动图可能比较快，建议多看几遍。

希望这篇文章对你有用。: )

资源部分源于网络，仅供学习&交流，禁商用，侵删。 - END - 往期精彩： 01. VBA实用小代码(九)：批量撤销合并单元格 02. VBA实用小代码(八)：批量合并单元格 03. VBA实用小代码(七)：添加返回目录按钮