Скопируйте несколько книг Excel в одну книгу

Question

Я пытаюсь скопировать несколько книг Excel в одну рабочую книгу, каждая из которых должна иметь собственную вкладку.

Я не знаю, как использовать VB, поэтому я пробовал много скриптов VB, которые я нашел с помощью Google, но по той или иной причине (ошибка 9, ошибка 91, ничего не происходит, все книги копируются в одну вкладку) Мне не удалось сделай это.

Answer 1

Если у вас не много рабочих книг, вы можете сделать это вручную, следуя этим инструкциям. Соответствующие выдержки:

• Щелкните правой кнопкой мыши на вкладке, которую вы хотите переместить, и выберите move or copy
• Выберите целевую книгу в списке
• Выберите место вкладки, где вы хотели бы его в целевой книге
• Нажмите ok

Если у вас много рабочих книг, вы можете автоматизировать их, следуя этим инструкциям. Соответствующие выдержки:

• Поместите все книги в один каталог и запишите путь к каталогу.
• Откройте целевую рабочую книгу
• Нажмите Developer -> Visual Basic
• В новом окне нажмите Insert -> Module

• Вставьте следующий код:

  Sub GetSheets()
  Path = "<INSERT PATH TO DIRECTORY HERE>"
  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
  

• Замените строку Path полным путем к каталогу с книгами

• Нажмите green arrow button со стрелкой, чтобы запустить код и объединить книги.

Answer 2

Это работает -

    Sub CopyBooks()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    Dim destinationWorkbook As Workbook
    Set destinationWorkbook = ThisWorkbook
    Dim sourceWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Const path As String = "C:\your\path\"
    Dim file As Variant

    Dim currentSheets As Long
    currentSheets = destinationWorkbook.Sheets.Count

    file = Dir(path & "*.xl*")

    While file <> ""
        Set sourceWorkbook = Workbooks.Open(path & file)
            For Each sourceWorksheet In sourceWorkbook.Worksheets
                sourceWorksheet.Copy after:=destinationWorkbook.Worksheets(currentSheets)
                currentSheets = currentSheets + 1
            Next
            sourceWorkbook.Close savechanges:=False
            file = Dir
    Wend

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    End Sub