VBA Combine vários arquivos do Excel em uma pasta de trabalho

Este tutorial mostrará como combinar vários arquivos do Excel em uma pasta de trabalho no VBA

A criação de uma única pasta de trabalho a partir de várias pastas de trabalho usando o VBA requer uma série de etapas a serem seguidas.

• Você precisa selecionar as pastas de trabalho das quais deseja os dados de origem - os arquivos de origem.
• Você precisa selecionar ou criar a pasta de trabalho na qual deseja colocar os dados - o arquivo de destino.
• Você precisa selecionar as folhas dos arquivos de origem que você deseja.
• Você precisa dizer ao código onde colocar os dados no arquivo de destino.

Combinando todas as planilhas de todas as pastas de trabalho abertas para uma nova pasta de trabalho como planilhas individuais

No código abaixo, os arquivos dos quais você precisa copiar as informações precisam ser abertos, pois o Excel fará um loop pelos arquivos abertos e copiará as informações em uma nova pasta de trabalho. O código é colocado na pasta de trabalho macro pessoal.

Esses arquivos são os ÚNICOS arquivos do Excel que devem ser abertos.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647

Sub CombineMultipleFiles ()On Error GoTo eh'declara variáveis ​​para conter os objetos necessáriosDim wbDestination As WorkbookDim wbSource As WorkbookDim wsSource As WorksheetDim wb como pasta de trabalhoDim sh como planilhaDim strSheetName As StringDim strDestName As String'desligar a atualização da tela para acelerar as coisasApplication.ScreenUpdating = False'primeiro crie uma nova pasta de trabalho de destinoDefina wbDestination = Workbooks.Add'obter o nome da nova pasta de trabalho para excluí-la do loop abaixostrDestName = wbDestination.Name'agora percorre cada uma das pastas de trabalho abertas para obter os dados, mas exclui seu novo livro ou a pasta de trabalho macro pessoalPara cada wb no aplicativo.If wb.Name strDestName E wb.Name "PERSONAL.XLSB" EntãoDefina wbSource = wbPara cada sh In wbSource.Worksheetssh.Copy After: = Workbooks (strDestName) .Sheets (1)Próximo shFim sePróximo wb'agora feche todos os arquivos abertos, exceto o novo arquivo e a pasta de trabalho macro pessoal.Para cada wb no aplicativo.If wb.Name strDestName E wb.Name "PERSONAL.XLSB" Entãowb.Close FalseFim sePróximo wb'remove a folha um da pasta de trabalho de destinoApplication.DisplayAlerts = FalseFolhas ("Folha1"). ExcluirApplication.DisplayAlerts = True'limpar os objetos para liberar a memóriaDefinir wbDestination = NothingDefinir wbSource = NothingDefina wsSource = NothingDefinir wb = Nada'liga a atualização da tela quando completaApplication.ScreenUpdating = FalseSair do SubEh:MsgBox Err.DescriptionEnd Sub

Clique na caixa de diálogo Macro para executar o procedimento na tela do Excel.

Seu arquivo combinado agora será exibido.

Este código percorreu cada arquivo e copiou a planilha para um novo arquivo. Se algum de seus arquivos tiver mais de uma folha - ele as copiará também - incluindo as folhas sem nada nelas!

Combinando todas as planilhas de todas as pastas de trabalho abertas em uma única planilha em uma nova pasta de trabalho

O procedimento a seguir combina as informações de todas as planilhas em todas as pastas de trabalho abertas em uma única planilha em uma nova pasta de trabalho que é criada.

As informações de cada planilha são coladas na planilha de destino na última linha ocupada da planilha.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869

Sub CombineMultipleSheets ()On Error GoTo eh'declara variáveis ​​para conter os objetos necessáriosDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorksheetDim wb como pasta de trabalhoDim sh como planilhaDim strSheetName As StringDim strDestName As StringDim iRws As IntegerDim iCols As IntegerDim totRws As IntegerDim strEndRng As StringDim rngSource As Range'desligar a atualização da tela para acelerar as coisasApplication.ScreenUpdating = False'primeiro crie uma nova pasta de trabalho de destinoDefina wbDestination = Workbooks.Add'obter o nome da nova pasta de trabalho para excluí-la do loop abaixostrDestName = wbDestination.Name'agora percorre cada uma das pastas de trabalho abertas para obter os dadosPara cada wb no aplicativo.If wb.Name strDestName E wb.Name "PERSONAL.XLSB" EntãoDefina wbSource = wbPara cada sh In wbSource.Worksheets'obtém o número de linhas e colunas na planilhash.ActivateActiveSheet.Cells.SpecialCells (xlCellTypeLastCell) .ActivateiRws = ActiveCell.RowiCols = ActiveCell.Column'definir o intervalo da última célula na planilhastrEndRng = sh.Cells (iRws, iCols) .Address'definir o intervalo de origem para copiarDefina rngSource = sh.Range ("A1:" & strEndRng)'encontre a última linha na planilha de destinowbDestination.ActivateDefina wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell) .SelecttotRws = ActiveCell.Row'verifique se há linhas suficientes para colar os dadosSe totRws + rngSource.Rows.Count> wsDestination.Rows.Count EntãoMsgBox "Não há linhas suficientes para colocar os dados na planilha de consolidação."GoTo ehFim se'adicione uma linha para colar na próxima linha para baixoIf totRws 1 Then totRws = totRws + 1Destino de rngSource.Copy: = wsDestination.Range ("A" & totRws)Próximo shFim sePróximo wb'agora feche todos os arquivos abertos exceto o que você desejaPara cada wb no aplicativo.If wb.Name strDestName E wb.Name "PERSONAL.XLSB" Entãowb.Close FalseFim sePróximo wb'limpar os objetos para liberar a memóriaDefinir wbDestination = NothingDefinir wbSource = NothingDefinir wsDestination = NothingDefinir rngSource = NothingDefinir wb = Nada'liga a atualização da tela quando completaApplication.ScreenUpdating = FalseSair do SubEh:MsgBox Err.DescriptionEnd Sub

Combinando todas as planilhas de todas as pastas de trabalho abertas em uma única planilha em uma pasta de trabalho ativa

Se você deseja trazer as informações de todas as outras pastas de trabalho abertas para aquela em que está trabalhando no momento, pode usar o código a seguir.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081

Sub CombineMultipleSheetsToExisting ()On Error GoTo eh'declara variáveis ​​para conter os objetos necessáriosDim wbDestination As WorkbookDim wbSource As WorkbookDim wsDestination As WorksheetDim wb como pasta de trabalhoDim sh como planilhaDim strSheetName As StringDim strDestName As StringDim iRws As IntegerDim iCols As IntegerDim totRws As IntegerDim rngEnd As StringDim rngSource As Range'definir o objeto de pasta de trabalho ativo para o livro de destinoDefinir wbDestination = ActiveWorkbook'obtém o nome do arquivo ativostrDestName = wbDestination.Name'desligar a atualização da tela para acelerar as coisasApplication.ScreenUpdating = False'primeiro crie uma nova planilha de destino em sua pasta de trabalho AtivaApplication.DisplayAlerts = False'retomar o próximo erro caso a folha não existaOn Error Resume NextActiveWorkbook.Sheets ("Consolidation"). Delete'redefinir a armadilha de erro para ir para a armadilha de erro no finalOn Error GoTo ehApplication.DisplayAlerts = True'adicionar uma nova planilha à pasta de trabalhoCom ActiveWorkbookDefina wsDestination = .Sheets.Add (Depois: =. Sheets (.Sheets.Count))wsDestination.Name = "Consolidação"Terminar com'agora percorre cada uma das pastas de trabalho abertas para obter os dadosPara cada wb no aplicativo.If wb.Name strDestName E wb.Name "PERSONAL.XLSB" EntãoDefina wbSource = wbPara cada sh Em wbSource.Worksheets'obtém o número de linhas na folhash.ActivateActiveSheet.Cells.SpecialCells (xlCellTypeLastCell) .ActivateiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells (iRws, iCols) .AddressDefina rngSource = sh.Range ("A1:" & rngEnd)'encontre a última linha na planilha de destinowbDestination.ActivateDefina wsDestination = ActiveSheetwsDestination.Cells.SpecialCells (xlCellTypeLastCell) .SelecttotRws = ActiveCell.Row'verifique se há linhas suficientes para colar os dadosSe totRws + rngSource.Rows.Count> wsDestination.Rows.Count EntãoMsgBox "Não há linhas suficientes para colocar os dados na planilha de consolidação."GoTo ehFim se'adicione uma linha para colar na próxima linha abaixo se você não estiver na linha 1If totRws 1 Then totRws = totRws + 1Destino rngSource.Copy: = wsDestination.Range ("A" & totRws)Próximo shFim sePróximo wb'agora feche todos os arquivos abertos exceto o que você desejaPara cada wb no aplicativo.If wb.Name strDestName E wb.Name "PERSONAL.XLSB" Entãowb.Close FalseFim sePróximo wb'limpar os objetos para liberar a memóriaDefinir wbDestination = NothingDefinir wbSource = NothingDefinir wsDestination = NothingDefinir rngSource = NothingDefinir wb = Nada'liga a atualização da tela quando completaApplication.ScreenUpdating = FalseSair do SubEh:MsgBox Err.DescriptionEnd Sub