How to merge multiple Excel spreadsheets into one?

Question

I have a set of worksheets (for example, suppose they are called file01.xls, file02.xls, file03.xls etc.), all with the same columns in the Sheet1 tab and with the other empty tabs. How do I join these sheets into one without having to open, copy and paste one by one?

An example for better illustration. Suppose file01.xls contains:

|    |   A    |      B       |
|----|--------|--------------|
| 1  | NOME   | RG           |
| 2  | João   | 12.345.678-9 |
| 3  | José   | 11.111.111-1 |
| 4  | Maria  | 12.121.212-1 |

file02.xls contains:

|    |    A    |       B       |
|----|---------|---------------|
| 1  | NOME    | RG            |
| 2  | Luís    | 55.555.555-5  |
| 3  | Carlos  | 98.765.432-1  |
| 4  | Ana     | 22.333.444-5  |

and which file03.xls contains:

|    |    A    |       B        |
|----|---------|----------------|
| 1  | NOME    | RG             |
| 2  | Marcos  | 12.321.234-3   |
| 3  | Edna    | 98.765.678-9   |
| 4  | Ida     | 99.888.777-6   |

What I want to get is a file_aggregated.xls that contains:

|     |    A    |       B        |
|-----|---------|----------------|
|  1  | NOME    | RG             |
|  2  | João    | 12.345.678-9   |
|  3  | José    | 11.111.111-1   |
|  4  | Maria   | 12.121.212-1   |
|  5  | Luís    | 55.555.555-5   |
|  6  | Carlos  | 98.765.432-1   |
|  7  | Ana     | 22.333.444-5   |
|  8  | Marcos  | 12.321.234-3   |
|  9  | Edna    | 98.765.678-9   |
| 10  | Ida     | 99.888.777-6   |

Answer 1

It is possible with the use of VBA

Code:

• Selects the files you want to merge
• Copy the title only from the first file.
• Copy from column A to the last column (in the case of example "B"), if the sheet is called "Sheet1"
• Glue in the spreadsheet Data

Uses the function SheetKiller() to remove a spreadsheet if it exists.

'https://professor-excel.com/merge-excel-files-combine-workbooks-one-file/
Sub FundirPastasDeTrabalhoExcel()
    Dim numberOfFilesChosen, i As Long, UltimaLinhaFonte As Long, UltimaLinhaDestino As Long, k As Long
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet, dados As Worksheet

    Application.DisplayAlerts = False

    'Seleção de arquivos
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    tempFileDialog.AllowMultiSelect = True
    numberOfFilesChosen = tempFileDialog.Show

    'Cria planilha de dados
    SheetKiller ("Dados")
    ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(Sheets.Count)).Name = "Dados"
    Set dados = ThisWorkbook.Worksheets("Dados")

    'Loop nos arquivos selecionados
    For i = 1 To tempFileDialog.SelectedItems.Count

        'Abre as Pastas de Trabalho Excel
        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))

        'Loop em cada planilha do arquivo (pasta de trabalho) aberto
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            'Se o nome da planilha é "Sheet1"
            With tempWorkSheet
                If .Name = "Sheet1" Then
                    UltimaLinhaFonte = .Cells(.Rows.Count, "A").End(xlUp).Row
                    UltimaLinhaDestino = dados.Cells(dados.Rows.Count, "A").End(xlUp).Row
                    UltimaColuna = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
                    'Verifica se é a primeira planilha para copiar o título
                    If i = 1 Then
                        k = 0
                    Else
                       k = 1
                    End If
                    'Copia e cola valores
                    .Range(.Cells(1 + k, "A"), .Cells(UltimaLinhaFonte, UltimaColuna)).Copy
                    dados.Range("A" & UltimaLinhaDestino + k).PasteSpecial xlPasteAllUsingSourceTheme
                End If
            End With
        Next tempWorkSheet

        'Fecha a Pasta de Trabalho
        sourceWorkbook.Close
    Next i
    'Deleta a Planilha temporária para remover possíveis erros na função SheetKiller
    SheetKiller ("tempSheetKiller")
    Application.DisplayAlerts = True
End Sub

Public Function SheetKiller(Name As String)
    'Remove Planilha
    Dim s As Worksheet, t As String
    Dim i As Long, k As Long
    k = ThisWorkbook.Sheets.Count
    If k = 1 Then
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(Sheets.Count)).Name = "tempSheetKiller"
        k = ThisWorkbook.Sheets.Count
    End If
    For i = k To 1 Step -1
        t = ThisWorkbook.Sheets(i).Name
        If t = Name Then
            Application.DisplayAlerts = False
            ThisWorkbook.Sheets(i).Delete
            Application.DisplayAlerts = True
        End If
    Next i
End Function