Слияние рабочих книг в новый файл

Question

Я пытаюсь объединить несколько файлов Excel из одной папки в новый файл. Я нашел решение в Интернете, которое добавляет мои файлы в открытый. Я действительно не в VBA Excel, поэтому я думаю, что это основная проблема, но я не могу этого сделать, все, что я пробовал, не работает должным образом. Я хотел бы изменить следующий код, чтобы создать новый файл под названием «summary» в «Path» и скопировать листы в этот новый файл, перезаписывая файл каждый раз, когда я это делаю, и после этого удаляю несколько исходных файлов.

Есть ли возможность объединить все эти файлы в один, не открывая все это?

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, что если это повторяющееся упражнение, вы можете рассмотреть более оптимизированное решение. Но это сработает для вас.

EDIT: изменен, чтобы иметь дело с существующим файлом назначения - если он существует, и открыто, то подключиться к нему в противном случае открыть его; Затем удалите все листы в существующий файл для подготовки копий

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 VBA нет другого способа открыть каждую Рабочую книгу на одном уровне приложений. Если это одноразовая тренировка Я бы придерживался кода, который у вас уже есть, и нести его. Если это упражнение, которое вы будете делать повторно и вам нужно эффективное решение, единственный вариант - использовать формат OpenXML, который не требует тяжелого процесса Excel, например. Создание решения C# с использованием библиотеки ClosedXML. Это, безусловно, сократит время, необходимое для консолидации ваших книг.