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

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

2 ответа2

3

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

  • Щелкните правой кнопкой мыши на вкладке, которую вы хотите переместить, и выберите 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 со стрелкой, чтобы запустить код и объединить книги.
1

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

    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

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .