How to merge multiple Excel spreadsheets into one?

It is possible with VBA

Code:

• Select the files you want to merge
• Copy the title of the first file only.
• Copy of column A to the last column (in the case of example "B"), if the worksheet is called "Sheet1"
• Queue in Worksheet Data

Use the SheetKiller() function 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