Sub hz()Dim bt, i, r, c, n, first As Longbt = 1 "表頭有幾行，這裡的1就改成幾Cells.ClearFor i = 1 To Sheets.Count If Sheets(i).Name <> ActiveSheet.Name Then If first = 0 Then c = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column Sheets(i).Range("A1").Resize(bt, c).Copy Range("A1") n = bt + 1: first = 1 End If r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row Sheets(i).Range("A" & bt + 1).Resize(r - 1, c).Copy Range("A" & n) n = n + r - bt End IfNextEnd Sub
親，請新建一個Sheet，命名為“彙總”（名字可以隨便改）。然後按“Alt+F11”開啟VBA編輯視窗，在左側對應的Sheet“彙總”上雙擊，右側空白處貼上下面的程式碼。關閉VBA視窗。然後按“Alt+F8”開啟宏視窗，選擇剛插入的宏，點選“執行”。
Sub hz()Dim bt, i, r, c, n, first As Longbt = 1 "表頭有幾行，這裡的1就改成幾Cells.ClearFor i = 1 To Sheets.Count If Sheets(i).Name <> ActiveSheet.Name Then If first = 0 Then c = Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column Sheets(i).Range("A1").Resize(bt, c).Copy Range("A1") n = bt + 1: first = 1 End If r = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row Sheets(i).Range("A" & bt + 1).Resize(r - 1, c).Copy Range("A" & n) n = n + r - bt End IfNextEnd Sub