上面工作表為例子，試著執行以下程式碼，耐心把下面的操作做好，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