Copie várias pastas de trabalho do Excel em uma pasta de trabalho

Question

Eu estou tentando copiar várias pastas de trabalho do Excel em uma única pasta de trabalho com cada uma das pastas de trabalho copiadas para ter sua própria guia.

Eu não sei como usar o VB, então eu tentei muitos scripts VB que encontrei usando o Google, mas por uma razão ou outra (erro 9, erro 91, nada acontece, todas as pastas de trabalho são copiadas em uma guia) não conseguiu fazê-lo.

    

Answer 1

Se você não tiver muitas pastas de trabalho, poderá fazê-lo manualmente seguindo estas instruções . Trechos relevantes:

• Clique com o botão direito do mouse na guia que você deseja mover e escolha move or copy
• Selecione o livro de destino na lista de solicitação
• Selecione o local da guia em que você gostaria no livro de destino
• Clique em ok

Se você tiver muitas pastas de trabalho, poderá automatizá-las seguindo estas instruções. Trechos relevantes:

• Coloque todas as pastas de trabalho no mesmo diretório e anote o caminho do diretório
• Abra a pasta de trabalho de destino
• Clique em Developer - > %código%
• Em nova janela, clique em Visual Basic - > %código%

• Cole o seguinte código:

  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
  

• Substitua a linha Insert pelo caminho completo para o diretório com as pastas de trabalho

• Clique no Module para executar o código e mesclar as pastas de trabalho.

Answer 2

Isso funciona -

    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