同一目錄下，自由選擇多個excel作業簿，再選擇格式一樣的作業表進行，合并到新的一個作業簿的一個表里。最終合并的表里還要增加兩個欄位：作業簿名稱 表名
比如：
A作業簿 兩個表： 表1 表2
B作業簿 兩個表： 表1 表2 表3
合并到C作業簿的一個表里在原有的資料基礎上，要增加兩個欄位：
欄位1：作業簿名稱
欄位2：表名
謝謝！！
這個網路上的一個文章：我不太懂：
一、函式代碼：
[vb] view plaincopy
1. Option Explicit
2. '* ************************************************************** *
3. '* 函式名稱：MergeXlsFile
4. '* 功能：自動合并指定路徑下的所有XLS檔案到一個檔案中
5. '* 引數說明：strPath：需要合并的XLS檔案所在路徑。
6. '* SheetCount：需要合并的單個作業簿中作業表數量
7. '* 作者：lyserver
8. '* 聯系方式：http://blog.csdn.net/lyserver
9. '* ************************************************************** *
10.
11. Public Function MergeXlsFile(ByVal strPath As String, Optional ByVal SheetCount As Byte = 1) As Boolean
12. Dim i As Integer
13. Dim strSrcFile As String
14. Dim nRows As Long, nCols As Long, nSheets As Byte, nNewRows() As Integer
15. Dim xlApp As Object, xlSrcBook As Object, xlNewBook As Object, xlSheet As Object, xlRange As Object
16.
17. On Error Resume Next
18. If Right(strPath, 1) <> "/" Then strPath = strPath & "/"
19. '如果需要合并檔案中的作業表數量小于1則退出
20. If SheetCount < 1 Then Exit Function
21. '洗掉掉該路徑下原來的合并檔案
22. If Dir(strPath & "合并后的檔案.xls") <> "" Then Kill strPath & "合并后的檔案.xls"
23. '獲得第1個XLS檔案
24. strSrcFile = Dir(strPath & "*.xls")
25. '如果檔案不存在則退出
26. If Len(strSrcFile) = 0 Then Exit Function
27. '創建一個Excel實體
28. Set xlApp = CreateObject("Excel.Application")
29. '新建一個作業簿
30. Set xlNewBook = xlApp.Workbooks.Add
31. '調整新建作業簿里作業表的數量
32. ReDim nNewRows(1 To SheetCount)
33. For i = 1 To SheetCount - xlNewBook.Sheets.Count
34. xlNewBook.Sheets.Add , xlNewBook.Sheets(xlNewBook.Sheets.Count)
35. Next
36. '回圈查找當前路徑下的所有XLS檔案
37. Do
38. '打開找到的XLS檔案
39. Set xlSrcBook = xlApp.Workbooks.Open(strPath & strSrcFile)
40. '回圈復制源XLS檔案里的作業表
41. nSheets = IIf(xlSrcBook.Sheets.Count < SheetCount, xlSrcBook.Sheets.Count, SheetCount)
42. For i = 1 To nSheets
43. Set xlSheet = xlSrcBook.Sheets(i)
44. '獲得源XLS檔案中第i個作業表實際資料的行列數
45. nRows = xlSheet.UsedRange.Rows.Count
46. nCols = xlSheet.UsedRange.Columns.Count
47. '使用范圍物件粘貼源XLS檔案資料到合并結果檔案中
48. Set xlRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(nRows, nCols))
49. xlRange.Select
50. xlRange.Copy
51. xlNewBook.Sheets(i).Cells(nNewRows(i) + 1, 1).PasteSpecial &HFFFFEFF8
52. '保存合并結果檔案中第i個作業表的行數
53. nNewRows(i) = xlNewBook.Sheets(1).UsedRange.Rows.Count
54. Next
55. '關閉打開的源XLS檔案
56. xlSrcBook.Close
57. '繼續查找下一個XLS檔案
58. strSrcFile = Dir()
59. Loop Until Len(strSrcFile) = 0
60. '保存并關閉合并結果檔案
61. xlNewBook.SaveAs strPath & "合并后的檔案.xls"
62. xlNewBook.Close
63. '退出Excel實體
64. xlApp.Quit
65. '釋放資源
66. Erase nNewRows
67. Set xlRange = Nothing
68. Set xlSheet = Nothing
69. Set xlNewBook = Nothing
70. Set xlSrcBook = Nothing
71. If Err.Number = 0 Then MergeXlsFile = True
72. End Function
二、呼叫方法：
[vb] view plaincopy
1. Sub main()
2. If MergeXlsFile("c:/temp", 1) Then
3. MsgBox "資料已成功合并!", vbInformation, "提示"
4. Else
5. MsgBox "資料合并失敗!", vbCritical, "提示"
6. End If
7. End Sub
uj5u.com熱心網友回復：
在Excel 2003中開始記錄宏，手動完成所需功能，結束記錄宏，按Alt+F11鍵，查看剛才記錄的宏對應的VBA代碼。轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/82880.html
標籤：VB基礎類