合并工作簿下的sheet-VBA代码

小火钳

已于 2023-10-20 16:05:41 修改

阅读量53

点赞数

分类专栏： VBA 文章标签： excel

于 2023-10-20 15:11:15 首次发布

本文链接：https://blog.csdn.net/HZQPEIQI/article/details/133946735

版权

VBA 专栏收录该内容

3 篇文章 0 订阅

订阅专栏

本文介绍了一个Excel宏，用于自动合并具有相同列数且字段顺序一致的工作表，允许标题行存在差异，用户输入标题行数后即可实现数据整合。

摘要由CSDN通过智能技术生成

作用:
1. 去除多余标题行
2. 标记是工作表名/sheetname
使用前提:
1. 列数相同
2. 字段的顺序相同
3. 允许首行为空,允许不在相同的区域,比如,一个在A1:D4,一个在G3:C6
使用方法:
1. 复制,粘贴到宏模块内,运行即可

Sub 合并工作表()
    Dim Sht As Worksheet, rng As Range, k&, n&, c&, a&, b&
    Dim result As Integer
    Application.ScreenUpdating = False
    '取消屏幕更新
    n = Val(InputBox("请输入标题的行数", "默认为1", 1))
    If n < 0 Then MsgBox "标题行数不能为负数。", 64, "提示": Exit Sub
    '取得用户输入的标题行数，如果为负数，退出程序
    Cells.ClearContents
    '清空当前表数据
   
    a = 1 '从a1开始填充
    For Each Sht In Worksheets
    '遍历工作表
        If Sht.Name <> ActiveSheet.Name Then
        '如果工作表名称不等于当前表名则进行汇总动作……
            Set rng = Sht.UsedRange
            
            '定义rng为表格已用区域
            k = k + 1 '标记是不是第一张表
            '累计K值
            If k = 1 Then
            '如果是首个表格，则K为1，则把标题行一起复制到汇总表
                rng.Copy
                [b1].PasteSpecial Paste:=xlPasteValues '仅粘贴数值 第一列留给工作表名
                c = Sht.UsedRange.Rows.Count '计算收割表的行数
            Else
                '否则，扣除标题行后再复制黏贴到总表，只黏贴数值
                rng.Offset(n).Copy
                Cells(ActiveSheet.UsedRange.Rows.Count + 1, 2).PasteSpecial Paste:=xlPasteValues
                c = Sht.UsedRange.Rows.Count - n '计算当前表的行数
            End If
            c = c + b '加上之前表的行数
            Range("A" & a & ":A" & c).Value = Sht.Name
            a = c + 1 '从以使用的表行的下一行开始粘贴
            b = c  '存储上一次表的粘贴行数
        End If
    Next
    
    Range("A1").Value = "工作表名"
    
    Application.ScreenUpdating = True '恢复屏幕刷新
End Sub