"功能：用當前工作薄每條記錄建立一個新的工作薄，每個新建工作薄以第一行為標題行，第二行為記錄，以A列記錄為工作薄名稱自動儲存。"友情提示：1、如何把下面的程式碼新增到VBA環境：點選“開發工具”－“visualBasic”進入vba編輯環境，在左側的“工程”樹裡點選滑鼠右鍵，選擇“插入”－“模組”，然後把下面的程式碼貼上到右側的編輯區裡。2、如何使用：可建立熱鍵呼叫，也可點選“開發工具”－“visualBasic”進入vba編輯環境，在該過程程式碼裡點選一下，然後點選工具欄上的執行按鈕（是一個實心三角形，滑鼠放上去停留一會，有提示“執行子過程/...”）。SubSplitExl()Application.DisplayAlerts=False"新建的文件存在時，不傳送警示，覆蓋式儲存DimlngRs&,lngCs&,cx&,strEndCl$DimtopR(),EveryR(),oExlAsObject,oWkAsWorkbookDimstrPath$strPath=ThisWorkbook.Path&"\"WithActiveSheet.UsedRangelngRs=.Rows.CountlngCs=.Columns.CountEndWithstrEndCl=Replace(Replace(Cells(1,lngCs).Address,"$",""),"1","")topR=Range("A1:"&strEndCl&"1")"資料標題行Forcx=2TolngRsEveryR=Range("A"&Format(cx)&":"&strEndCl&Format(cx))"把每行記錄放入陣列SetoWk=Application.Workbooks.AddWithoWk".Parent.Visible=TrueWith.Sheets(1).Range("A1:"&strEndCl&"1")=topR"把標題行放入另建的工作薄.Range("A2:"&strEndCl&"2")=EveryR"把單個記錄放入同一另建的工作薄EndWith.SaveAsFilename:=strPath&EveryR(1,1)&".xls""以每行A列記錄為工作薄名稱.CloseEndWithNextSetoWk=NothingSetoExl=NothingErasetopR:EraseEveryRApplication.DisplayAlerts=TrueEndSub