如何多個excel 放在一個excel?

ui123

最近遇到一個難題>''<，情形是這樣的:

我有一個資料夾(可能放在不同位置，所以可能需要一個可以選資料夾的視窗)，裡面有很多excel檔，可能情形如下:

1.A檔名的excel 有兩個sheet,B檔名的excel 的有10個sheet,....(每一個excel 裡面的sheet數目不一定一樣)
2.excel 檔名不一樣，但sheet檔名可能一樣

有辦法將多個excel放在一個excel，不同excel 的sheet檔名可以用: excel檔名"_"sheet檔名來命名?

不知道這個問題會不會太難? .....

c_c_lai

回復 1# ui123
請上傳檔案。

ui123

謝謝 c_c_lai 大的熱心~!我好像不還沒有權限耶~
還是我再敘述更清楚一下:
假如果桌面有個資料夾，名稱為"AllFile"
裡面有兩個excel(可能更多)，
一個excel名稱為:
Data1 並且有2個SHEET,名稱為SHEET1,SHEET2
另一個excel名稱為:
Data2 並且有3個SHEET,名稱為SHEET1,SHEET2,SHEET3
(實際上excel數可能更多，每個excel SHEET數量不一定，想放在一個EXCEL裡)
應該可以用迴圈嗎?還是搜尋?...自己的想法如下:
For i=excel名稱
數有幾個sheet 重新命sheet名稱為"excel檔名_原SHEET名稱"
Next i
然後把改好的檔案放在一起....正在學習語法,感謝指教!

還有再次謝謝GBKEE大~ 剛剛才看到您的提醒，Sorry&謝謝提醒囉!

c_c_lai

謝謝 c_c_lai 大的熱心~!我好像不還沒有權限耶~
還是我再敘述更清楚一下:
假如果桌面有個資料夾，名稱為" ...
ui123 發表於 2013-11-10 19:03

妳可以將AllFiles 目錄及檔案一起壓縮成 .rar 或 .zip 壓縮檔，
妳便可以上傳了。

ui123

AllFile.rar (12.33 KB)

Sample
下載次數: 22

2013-11-10 19:28

Ya~我會上傳了
不知道你有看到嗎?
應該還要用數sheet?的語法 Worksheets.Count ?
然後For each i .....不管有沒有解，都要感謝您，謝謝!~

GBKEE

回復 5# ui123
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim xFileAr, i As Integer, x As Integer, S As Integer
   
4.     Dim wB As Workbook
   
5.     With Application.FileDialog(msoFileDialogFilePicker)    '選資料夾的視窗
   
6.         Do                                                  '迴圈: 可多次選資料夾
   
7.             .Show                                           '顯示:資料夾的視窗
   
8.             For i = 1 To .SelectedItems.Count               '選擇的檔案之個數
   
9.                 xFileAr = xFileAr & "," & .SelectedItems(i) '紀錄字串:選擇的檔案之完整路徑
   
10.             Next
    
11.         Loop Until .SelectedItems.Count = 0                 '一直到沒有選擇檔案
    
12.         If xFileAr = "" Then Exit Sub
    
13.      End With
    
14.      xFileAr = Split(Mid(xFileAr, 2), ",")                   '紀錄選擇的檔案字串轉換為陣列
    
15.      Set wB = ThisWorkbook        '這程式碼所在的活頁簿      '或是 Workbooks("AAA.XLS") '多個excel放在一個excel
    
16.      For i = 0 To UBound(xFileAr)
    
17.         With Workbooks.Open(xFileAr(i))  '要開啟的多個excel...
    
18.             x = wB.Sheets.Count                                 '這活頁簿的工作表數量
    
19.             For S = 1 To .Sheets.Count
    
20.                 .Sheets(S).Copy wB.Sheets(x)           '工作表複製,
    
21.                 ActiveWorkbook.ActiveSheet.Name = .Name & "_" & .Sheets(S).Name
    
22.             Next
    
23.             .Close False
    
24.         End With
    
25.      Next
    
26. End Sub

複製代碼

ui123

GBKEE超級版大~可以用，而且竟然可以多層耶!   謝謝你 ^^~

(當然還有謝謝 c_c_lai 小狗狗教我上傳資料)

有個小小疑問，有辦法依照Data1.xlsx_Sheet1然後Data1.xlsx_Sheet2排列順序?
剛剛試一下，好像剛好相反了

還有我會努力把你寫的程式看懂的~

果然是超級版主，超級厲害的!

GBKEE

回復 7# ui123

1.     For S = .Sheets.Count To 1 Step -1         '索引值由後往前
   
2.                 .Sheets(S).Copy wB.Sheets(1)  '複製工作表,在這活頁簿的第1個工作表之前
   
3.                 ActiveWorkbook.ActiveSheet.Name = .Name & "_" & .Sheets(S).Name
   
4.             Next  

複製代碼

ui123

我有試了!  成功了~超開心
這幾天我會努力&試著 讀懂它~ 謝謝  超級版大 (◕‿◕✿

c_c_lai

GBKEE超級版大~可以用，而且竟然可以多層耶!   謝謝你 ^^~

(當然還有謝謝 c_c_lai 小狗狗教我上傳資料) ...
ui123 發表於 2013-11-10 20:22

小狗狗只是在懷舊而已，歲月已逝！
順便再提示妳，當要回答對方時，請一定要先點按 左下方的 "回復" 選鈕
再行作答。否則對方是不知道妳已回復了，就好比是你會看到 "有(1)消息" 的訊息情況。
還好 GBKEE 版大有留意到，否則一般當事人會不知道因此而無法答覆妳的。   
恭喜妳終於得到解答了！  
(P.S.  這是引發妳先行上傳檔案的目的，GBKEE 版大不好意思哦)