執行excel後按住alt依序按f11,i,m
貼上下面程式碼後做必要修改後按f5 即可在目前工作表中得到匯總結果.
Sub test()
c = Array(1, 3, 5, 7, 8)
p = ＂d：\總計檔案所在目錄\＂ '依實際修改 注意別遺漏最後的\
f = Dir(p & ＂*.xlsx＂)
Set ns = ActiveSheet
Do Until f = ＂＂
Set wb = Workbooks.Open(p & f)
For i = 0 To 4
n = n 1
ns.Cells(2, n).Resize(144).Value = wb.Sheets(＂1號房間＂).Cells(2, c).Resize(144).Value
Next
wb.Close False
f = Dir
Loop
End Sub
樓主，我認為您這個事可行，出家人不敢打妄語， 我不出家人也不敢打妄語！
如果您也不想放棄這個機會的話，我願一試，請HI我留言。
回答者： lxlzmh2002 - 大魔法師 八級 2009-8-19 04:40
================================================= ==========================
樓主，今天幫人寫了一個多表合併的VBA程序，忽然想起好像看過有類似要的貼子，所以就找到您這個貼子，再來回答一次：
VBA程式碼如下：
Dim sht As Worksheet
Dim rs As Long, js As Long, ds As Long
Dim i As Integer
On Error Resume Next
Set sht = Sheets（＂匯總＂）
If Err.Number = 0 Then
Sheets（＂匯總＂）.Select
ActiveSheet.Range(＂A1＂).CurrentRegion.ClearContents
Else
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = ＂總和＂
End If
Sheets(2).Range(＂1:1＂).Copy Sheets（＂匯總＂）.Range(＂A1＂)
For i = 2 To Sheets.Count
#ds = Sheets（＂匯總＂）.Range(＂A65536＂).End(xlUp).Row 1rs = Sheets(i).Range(＂A65536＂).End(xlUp).Row
js = Sheets(i).Range(＂A1＂).End(xlToRight).Column
With Sheets(i)
.Select
.Range(Cells(2, 1), Cells(rs, js)).Copy Sheets（＂匯總＂）.Cells(ds, 1)
End With
Next
Sheets（＂匯總＂）.Select
上述程式碼使用方法如下：
錄製巨集：選單＂工具＂->巨集->錄製巨集）--> ＂宏名＂處為巨集取名字->設定快捷鍵，＂快捷鍵＂下面輸入一個字母-->確定後開始錄製巨集。
編輯巨集：開始錄製後即可直接按停止鍵， 然後編輯巨集（工具->巨集->巨集（M）->選擇剛建那個巨集->點右邊的＂編輯＂按鈕-->進入巨集編輯介面-->刪除Sub XXX 至End Sub之間所有內容-->然後貼上上述程式碼-->按工具列上的＂儲存＂按鈕-->＂檔案＂選單-->關閉並反回MicorSoft Excel
執行巨集： 按剛剛設定的快捷鍵（Ctrl 那個字母）， 或透過選單＂工具＂-->巨集-->巨集（M）-->視窗上選宏名， 按＂執行＂按鈕執行巨集.
================================================= ====================##這段VBA程式碼功能說明：
1.執行VBA程式碼之後，程式會自行增加一個名為＂匯總＂的工作表.
2.將sheet1（叫不叫sheet1無索味，程式自會知道名字）的第一行作為＂匯總＂表的第一行。
3.然後依序將＂匯總＂表以外的工作表內， 從第二行開始的所有行所有列以追加方式添加到＂匯總＂表內（通常認為第一行是標題）
4.追加過程，相當於複製貼上，但要比手工複製貼上快得多，可以說是瞬間完成。並且是您用快捷鍵執行一次，所有工作表全部匯總一次。 ### ###行與不行，您一試便知。關於這個程式碼的使用方面有問題，請Hi我~~~~~#####
以上是如何將多個200個左右的excel檔案提取指定列資料並彙總到一個新檔案中的詳細內容。更多資訊請關注PHP中文網其他相關文章！
