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 merge 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 |
that 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 that 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_aggregado.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 :
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