Excel 合併多個檔案的 Sheet 1 到一個檔案中

最近在進行 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