Question

我尝试将多个Excel文件从一个文件夹合并到一个新文件中。我在互联网上找到了一个解决方案，就是将我的文件添加到一个开放的文件中。我并没有真正进入VBA Excel，所以我认为这是一个基本问题，但我不能这样做，我尝试过的东西并没有正常工作。我想更改以下代码来创建一个名为＆＃34; summary＆＃34;的新文件。在＆＃34;路径＆＃34;并将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，如果这是一个重复练习，你可以考虑一个更简化的解决方案。但这对你有用。

编辑：已更改为处理现有目标文件 - 如果它存在且已打开，则连接到它，否则打开它;然后删除现有文件中的所有工作表以准备副本

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

首先，无论您的解决方案如何，如果要合并所有Excel工作簿，仍需要打开每个Excel工作簿。

其次，我想您可能希望将您的问题重新解释为＆＃34;是否有可能将所有这些文件合并到一个更快或更简单的方式？＆＃34 ;

从Excel VBA级别开始，实际上没有其他方法可以在同一个应用程序级别中打开每个工作簿。 如果这是一次性练习 ，我会坚持使用您已有的代码并坚持下去。但是， 如果这是一个您将反复进行的练习 并且需要一个有效的解决方案，那么您唯一的选择就是采用不需要重量级Excel流程的OpenXML格式，例如： 使用ClosedXML库创建C＃解决方案。这肯定会缩短整合工作簿所需的时间。

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

2 个答案: