将工作簿合并到一个新的文件

我试图从一个文件夹合并多个Excel文件到一个新的文件。 我在互联网上find了一个解决scheme，那就是将我的文件添加到一个开放的文件中。 我不是真的进入VBA Excel，所以我认为这是一个基本的问题，但我做不到，我试过的东西没有正常工作。 我想更改下面的代码，在“path”中创build一个名为“summary”的新文件，并将这个Sheets复制到这个新文件中，每次覆盖这个文件并在这之后删除几个源文件。

有没有可能将所有这些文件合并成一个没有打开所有的人？

Sub GetSheets() Path = "C:\Merging\" FileName = Dir(Path & "*.xls") Do While FileName <> "" Workbooks.Open FileName:=Path & FileName, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(FileName).Close FileName = Dir() Loop End Sub 

Answer 1

你的代码几乎可以正常工作，只需要稍微调整一下。 我也同意@AnalystCave，如果这是一个重复的练习，你可以考虑一个更简化的解决scheme。 但是，这将为你工作。

编辑：改变处理现有的目标文件 – 如果它存在，并打开，然后连接到它，否则打​​开它; 然后删除现有文件中的所有工作表以准备复印件

 Option Explicit Function IsSheetEmpty(sht As Worksheet) As Boolean IsSheetEmpty = Application.WorksheetFunction.CountA(sht.Cells) = 0 End Function Sub GetSheets() Dim Path, Filename As String Dim Sheet As Worksheet Dim newBook As Workbook Dim appSheets As Integer Dim srcFile As String Dim dstFile As String Dim dstPath As String Dim wasntAlreadyOpen As Boolean Application.ScreenUpdating = False 'go faster by not waiting for display '--- create a new workbook with only one worksheet dstFile = "AllSheetsHere.xlsx" dstPath = ActiveWorkbook.Path & "\" & dstFile wasntAlreadyOpen = True If Dir(dstPath) = "" Then '--- the destination workbook does not (yet) exist, so create it appSheets = Application.SheetsInNewWorkbook 'saves the default number of new sheets Application.SheetsInNewWorkbook = 1 'force only one new sheet Set newBook = Application.Workbooks.Add newBook.SaveAs dstFile Application.SheetsInNewWorkbook = appSheets 'restores the default number of new sheets Else '--- the destination workbook exists, so ... On Error Resume Next wasntAlreadyOpen = False Set newBook = Workbooks(dstFile) 'connect if already open If newBook Is Nothing Then Set newBook = Workbooks.Open(dstPath) 'open if needed wasntAlreadyOpen = True End If On Error GoTo 0 '--- make sure to delete any/all worksheets so we're only left ' with a single empty sheet named "Sheet1" Application.DisplayAlerts = False 'we dont need to see the warning message Do While newBook.Sheets.Count > 1 newBook.Sheets(newBook.Sheets.Count).Delete Loop newBook.Sheets(1).Name = "Sheet1" newBook.Sheets(1).Cells.ClearContents newBook.Sheets(1).Cells.ClearFormats Application.DisplayAlerts = True 'turn alerts back on End If Path = "C:\Temp\" Filename = Dir(Path & "*.xls?") 'add the ? to pick up *.xlsx and *.xlsm files Do While Filename <> "" srcFile = Path & Filename Workbooks.Open Filename:=srcFile, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets '--- potentially check for blank sheets, or only sheets ' with specific data on them If Not IsSheetEmpty(Sheet) Then Sheet.Copy After:=newBook.Sheets(1) End If Next Sheet Workbooks(Filename).Close (False) 'add False to close without saving Kill srcFile 'deletes the file Filename = Dir() Loop '--- delete the original empty worksheet and save the book If newBook.Sheets.Count > 1 Then newBook.Sheets(1).Delete End If newBook.Save '--- leave it open if it was already open when we started If wasntAlreadyOpen Then newBook.Close End If Application.ScreenUpdating = True 're-enable screen updates End Sub 

Answer 2

首先 ，无论您的解决scheme是否需要打开每个Excel工作簿，如果你想合并所有的Excel工作簿。

其次 ，我认为你可能想把你的问题改为“是否有可能把所有这些文件合并成一个更快或更简单的方法？”

从Excel VBA的级别来看，在同一应用程序级别中打开每个工作簿真的没有其他办法。 如果这是一次性练习，我会坚持你已经拥有的代码并且忍受它。 但是， 如果这是一个练习，您将需要重复进行并需要一个有效的解决scheme，唯一的select就是使用OpenXML格式，而不需要重量级的Excel过程，例如使用ClosedXML库创buildC＃解决scheme。 这肯定会减less合并工作簿所需的时间。