Excel VBA批量汇总合并工作表，横着放，竖着放，你随意，纯干货

 

 

上面工作表为例子，试着执行以下代码，耐心把下面的操作做好，Excel    简化日常工作指日可待------>微信CSDN_xzy

 

执行步骤:

(1)做好工作表，内容见上图1.1-->第一个工作表写1就好-->1.2第二2个工作表写2就好<格式一样>PS:第二张图只是示意一下

(2)ALT+F11调出开发工具窗口

(3)对象鼠标右键->新建模块->双击打开模块

(4)竖着排复制DownGather代码

(5)按F5执行

(6)横着排复制RightGather代码

(7)按F5执行

(综合问题)1.Excel没启用宏，->解决方法度娘

                2.Excel工作表中只放数字就好，理解一下是怎么做到的

                3.再F5之前删除第一个工作表

                4.实际应用中，先备份工作表，手动麻烦，试着写一段或去百度抄一段自动备份（不备份总有一天你会哭天喊地）

                5.关注博主，时刻分享干货

 

 

Sub DownGather()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
        Sheets(1).Select
        Sheets.Add '新建一个汇总表
        Sheets(1).Name = "DownGather"
        Dim i, j, k As Integer
            For k = 2 To Sheets.Count
                j = Sheets("DownGather").[a65536].End(3).Row + 1 '汇总所有工作表到第一个工作表，向下排列。表中间如果空一行把1改成2
                Sheets(k).Select
                i = Sheets(k).[a65536].End(3).Row
                Sheets(k).Rows("1" & ":" & i).Copy Sheets("DownGather").Cells(j, 1) '如果有标题列，把前面一个1改成2
            Next
            Sheets(1).Select
            Rows(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

Sub RightGather()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
        Sheets(1).Select
        Sheets.Add '新建一个汇总表
        Sheets(1).Name = "RightGather"
        Dim i, j, k, m As Integer
            For k = 2 To Sheets.Count
                j = Sheets("RightGather").Cells(1, Columns.Count).End(xlToLeft).Column + 2 '排列中间不要空一行，把最后一个2改成1
                Sheets(k).Select
                i = Sheets(k).[a65536].End(3).Row
                m = Sheets(k).Cells(1, Columns.Count).End(xlToLeft).Column
                Sheets(k).Range(Cells(1, 1), Cells(i, m)).Copy Sheets("RightGather").Cells(1, j) '如果有标题列，把前面一个1改成2
            Next
            Sheets(1).Select
            Columns("A:B").Delete ' '排列中间不要空一行，括号里直接写一个A
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub