將許多Excel文件合併爲一個

Question

我正在尋找一種方法將許多Excel文件合併爲一個。

我有超過10個具有相同數量的列和類似信息的文件。我知道我可以將它們全部打開並複製並粘貼到一箇中，但我正在尋找一種更快的方法來完成它。

我也知道我可以將它們更改爲.csv文件並將它們合併爲一個使用cmd命令。

我想要一個辦法做到這一點，不必打開所有的。

Answer 1

你還沒有說過每個文件只有一張紙。無論如何，假設它只有一個（並且總是第一個），您可以使用下面的代碼。請將「C：\ MyDirectory \ MyFiles」替換爲保存文件的文件夾的適當路徑。

注意：文件打開過程不是我的工作。我在這裏幫助： http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/

希望這有助於...

'note: the file opening procedure is not my work. I got help here: 
 
'http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/ 
 

 
Sub Merge_Files() 
 
Dim objFSO As Object 
 
Dim objFolder As Object 
 
Dim objFile As Object 
 
Dim i As Long 
 
Dim col_no As Long, row_no As Long 
 
Dim arr_ws As Variant 
 
Dim ws1 As Worksheet, wb1 As Workbook 
 
Dim col_ws1 As Long, row_ws1 As Long 
 

 
Set wb1 = ThisWorkbook 
 
Set ws1 = ActiveSheet 
 

 
'Create an instance of the FileSystemObject 
 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
 
'Get the folder object 
 
Set objFolder = objFSO.GetFolder("C:\MyDirectory\MyFiles") 
 
i = 0 
 
'loops through each file in the directory and prints their names and path 
 
For Each objFile In objFolder.Files 
 
    i = i + 1 
 
    Workbooks.Open Filename:=objFile 
 
    row_no = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row 
 
    col_no = ActiveSheet.Range(Cells(1, Columns.Count), Cells(1, Columns.Count)).End(xlToLeft).Column 
 
    arr_ws = ActiveSheet.Range(Cells(1, 1), Cells(row_no, col_no)) 
 
    ActiveWorkbook.Close savechanges = no 
 
    ws1.Activate 
 
     If ws1.Range("A1").Value <> "" Then 
 
      row_ws1 = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1 
 
      col_ws1 = ActiveSheet.Range(Cells(1, Columns.Count), Cells(1, Columns.Count)).End(xlToLeft).Column 
 
     Else 
 
      row_ws1 = 1 
 
      col_ws1 = 1 
 
     End If 
 
    ws1.Range(Cells(row_ws1, 1), Cells(row_ws1 + row_no - 1, col_no)) = arr_ws 
 
    
 
Next objFile 
 
End Sub