麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 開啟中的工作簿合併至另一工作簿中 [打印本頁]

作者: hsiaohsien 時間: 2011-9-19 20:42 標題: 開啟中的工作簿合併至另一工作簿中

這是我錄下的巨集，每月有30天的檔案，我想在全部開啟的情形下，使用這樣的巨集將特定的工作表分別複製到合併.xls成為單一檔案，有30個工作表中
Sub Macro1()
'
' Macro1 Macro
' hsiaohsien 在 2011/9/19 錄製的巨集
'

'
Windows("0919.xls").Activate
Sheets("統計").Select
Sheets("統計").Copy After:=Workbooks("合併.xls").Sheets(2)
Sheets("統計").Select
Sheets("統計").Name = "0919" '<---------工作表名稱命名以工作簿檔名
End Sub

Sub Macro2()
'
' Macro1 Macro
' hsiaohsien 在 2011/9/19 錄製的巨集
'

'
Windows("0918.xls").Activate
Sheets("統計").Select
Sheets("統計").Copy After:=Workbooks("合併.xls").Sheets(3)
Sheets("統計").Select
Sheets("統計").Name = "0918" '<---------工作表名稱命名以工作簿檔名
End Sub

作者: GBKEE 時間: 2011-9-20 06:32

回復 1# hsiaohsien

Sub Ex()
Dim Wb As Workbook
For Each Wb In Workbooks
If Wb.Name <> "合併.xls" Then '排除 "合併.xls"
Wb.Sheets("統計").Copy After:=Workbooks("合併.xls").Sheets(2)
ActiveSheet.Name = Replace(Wb.Name, ".xls", "")
End If
Next
Workbooks("合併.xls").Activate
End Sub

複製代碼

作者: waterful.tw 時間: 2011-9-30 12:39

Dear GBKEE版大，

1.我試了您的方法，但卻出現 "陣列索引超出範圍 (錯誤 9)"，程式碼如下：
Sub 統計()
Dim Wb As Workbook
For Each Wb In Workbooks
   If Wb.Name <> "統計.xls" Then '排除 "統計.xls"
      Wb.Sheets("Sheet2").Copy After:=Workbooks("統計.xls").Sheets(2) '錯誤9
         ActiveSheet.Name = Replace(Wb.Name, ".xls", "")
   End If
Next
Workbooks("統計.xls").Activate
End Sub
2.我另外又加了路徑，但卻出現 "型態不符合 (錯誤 13)"，程式碼如下：
Sub 統計()
Dim MyBook, Wb As Workbook, MyPath As Long
Set MyBook = ThisWorkbook
MyPath = MyBook.Path & "\"                                     '型態不符
  With Workbooks.Open(MyPath & "*.xls")
   For Each Wb In Workbooks
      If Wb.Name <> "統計.xls" Then
         Wb.Sheets("Sheet2").Copy after:=MyBook.Sheets(Sheets.Count)
         ActiveSheet.Name = Replace(Wb.Name, ".xls", "")
      End If
   Next
End With
Workbooks("統計.xls").Activate
End Sub
3.我是要將不同檔名的檔案匯入一個excel檔內，再來作資料處理。

作者: Hsieh 時間: 2011-9-30 19:30

Sub ex()
Dim MyPath As String, fs As String, MySht As Worksheet
MyPath = ThisWorkbook.Path & "\"
fs = Dir(MyPath & "*.xls")
Do Until fs = ""
If fs <> ThisWorkbook.Name Then
With Workbooks.Open(fs)
Set MySht = .Sheets(2) '要複製的工作表
MySht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Replace(fs, ".xls", "")
.Close
End With
End If
fs = Dir
Loop
End Sub

複製代碼

回復 3# waterful.tw

作者: waterful.tw 時間: 2011-10-1 09:27

謝謝Hsieh 版大，

作者: waterful.tw 時間: 2011-10-1 09:29

sorry回復到一半，等我用Hsieh版大的方法試試，有問題再來麻煩囉~

作者: GBKEE 時間: 2011-10-1 14:54

回復 3# waterful.tw
Wb.Sheets("Sheet2").Copy After:=Workbooks("統計.xls").Sheets(2) '錯誤9 ->沒有2 , 會有1  你用 Sheets.Count替代也行

Dim MyPath As Long       '  -> 數字  Long (長整數)變數係以範圍從 -2,147,483,648 到 2,147,483,647 之 32 位元 (4 個位元組) 有號數字形式儲存。
Set MyBook = ThisWorkbook
MyPath = MyBook.Path & "\"                                  '當然是型態不符
Dim MyPath As String  ->應修改維字元
'String之字元碼的範圍從 0 到 255。字元集的前 128 個字元 ( 0 到 127 ) 對應於標準的 U.S 鍵盤上的字元與符號

作者: waterful.tw 時間: 2011-10-3 09:03

Dear Hsieh & GBKEE版大，
我已複製您的程式，並修改MyPath的型態為String，結果現在是在with那行出現執行階段錯誤'1004'=>找不到檔案或檔名錯誤！
奇怪的是，"C:\Documents and Settings\Administrator\桌面\try and error\*.xls"不是電腦自己抓的? 檔名"*.xls"應該也沒錯阿? 感覺越來越亂了...orz

作者: GBKEE 時間: 2011-10-3 16:20

本帖最後由 GBKEE 於 2011-10-3 17:16 編輯

回復 8# waterful.tw

MyPath = ThisWorkbook.Path & "\"
fs = Dir(MyPath & "*.xls")

請加上  ChDir  MyPath    改變目前的目錄  來修正錯誤

如目前的目錄或檔案夾在 ThisWorkbook.Path & "\"
With Workbooks.Open(fs) -> 開啟目前的目錄下檔案fs  所以不會有錯誤.
如目錄或檔案夾不在 ThisWorkbook.Path & "\"
也可修正為 With Workbooks.Open(MyPath & fs)    ->如 : d:\test\ fs
以避免目前的目錄或檔案夾不是在  ThisWorkbook.Path -> With Workbooks.Open(fs) 會產生錯誤

可用 MsgBox  CurDir  查看目前的目錄或檔案夾
CurDir函數  ->傳回一個 Variant (String)，用來代表目前的路徑。
Excel 開啟時會依如圖設立目前的目錄或檔案夾

[attach]8081[/attach]

作者: waterful.tw 時間: 2011-10-4 08:16

回復 9# GBKEE

謝謝GBKEE版大，我後來發現，可能是我要合併的工作簿格式太過複雜(由.csv檔跑過巨集，在另存為.xls檔)，EXCEL記憶體負荷不了，所以才會一值跑出'1004'執行階段錯誤！後來我改為先將csv檔資料合併到excel工作頁，在用巨集做資料處理，就OK了！不過還是謝謝版大，讓我又學到一招了！

作者: chaoyiho 時間: 2016-5-3 14:13

雖然是舊文章但是仍然受教了! 非常感謝各位前輩

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)