最近在進行 Excel 檔導入資料，沒想到程式開發好了之後，廠商竟然是把資料分開提供，一百多個檔案，不可能每個月都分成一百多次進行導入，於是就想起了用VBA來整理成一個檔案了
分成一百多個檔案，是整我嗎？
打開 Excel 之後，用 Alt+F11 開啟 vba 編輯器，接著點選 "插入" 新增 "模組"
接著在模組中貼上 VBA 之後點選 F5 開始執行，就會把資料都整理在這個 Excel 第一個 Sheet 了
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("D:\Excels\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj, UpdateLinks:=False, ReadOnly:=True)
ActiveSheet.AutoFilterMode = False
bookList.Worksheets("Sheet1").Select
bookList.Worksheets("Sheet1").AutoFilterMode = False
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close False
Next
End Sub
新增一種只抓取特定行並且貼上值，避免原本的資料是公式，
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'修改Excel檔的所在資料夾
Set dirObj = mergeObj.Getfolder("D:\Excels\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj, UpdateLinks:=False, ReadOnly:=True)
ActiveSheet.AutoFilterMode = False
bookList.Worksheets("Sheet2").Select
bookList.Worksheets("Sheet2").AutoFilterMode = False
'我只要這個範圍的資料
Range("A4:L4").Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
bookList.Close False
Next
End Sub
