Início » Blog Guia do Excel » Unir planilhas Excel com VBA

Unir planilhas Excel com VBA

Neste artigo apresentaremos um código VBA Excel que realiza a unificação de planilhas.

Imagine a seguinte situação. Você tem várias pastas de trabalho Excel preenchidas por diversos usuários, ou ainda vieram dezenas de arquivos referentes á um mês de processamento de arquivos de um determinado fornecedor e você gostaria de uni-los para analisá-los.

Este código VBA Excel realiza a unificação das planilhas que estiverem abertas em um único arquivo informado no início do processo.

Abaixo o processo como funciona:

1. Copie o código VBA e adicione á sua pasta Personal. Veja aqui como realizar esta tarefa: Habilitando a guia desenvolvedor e copiando códigos VBA da internet.

'UnificarPlanilhas Macro
Sub lsUnificarPlanilhas()

  Dim Message As String
  Dim Title As String
  Dim Default As String
  Dim MyValue As String
  Dim wb As Workbook
  Dim lUltimaColunaAtiva As Long
  Dim lUltimaLinhaAtiva As Long
  Dim lRng As Range
  
  Message = "Informe o nome da Planilha de Destino"
  Title = "Unificar Planilhas"
  Default = "1"
 
  'Solicita informação da planilha que será unificada
  PlanilhaDestino = InputBox(Message, Title, Padrão)
  If PlanilhaDestino = "" Then
     MsgBox "Planilha não informada, a macro será Finalizada!"
     Exit Sub
  End If
 
  'Verificar se o arquivo existe
  For i = 1 To Workbooks.Count
      If Workbooks(i).Name = PlanilhaDestino Then
          Exit For
      Else
        If i = Workbooks.Count Then
          MsgBox "Planilha Destino não Encontrada, a macro será Finalizada!"
          Exit Sub
        End If
      
      End If
  Next i
  
  'Colar os dados selecinoados
  For i = 1 To Workbooks.Count
       If Workbooks(i).Name <> "PERSONAL.XLSB" And Workbooks(i).Name <> PlanilhaDestino Then
            Workbooks(Workbooks(i).Name).Worksheets(1).Activate
            
            lUltimaLinhaAtiva = Cells(Rows.Count, 1).End(xlUp).Row
            lUltimaColunaAtiva = ActiveSheet.Cells(1, 5000).End(xlToLeft).Column
            Set lRng = Range(Cells(1, lUltimaColunaAtiva).Address)
            
            Range("A" & 2 & ":" & gfLetraColuna(lRng) & lUltimaLinhaAtiva).Select
            Selection.Copy
            
            Workbooks(PlanilhaDestino).Worksheets(1).Activate
            
            lUltimaLinhaAtiva = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Range("A" & lUltimaLinhaAtiva).Select
            
            ActiveSheet.Paste
            Application.CutCopyMode = False
      End If
          
  Next i
  ' Fecha planilhas unificadas
  For Each wb In Application.Workbooks
    If wb.Name <> "PERSONAL.XLSB" And wb.Name <> PlanilhaDestino Then
        wb.Close SaveChanges:=False
    End If
  Next
 
End Sub

Function gfLetraColuna(ByVal rng As Range) As String
    Dim lTexto() As String
    
    lTexto = Split(rng.Address, "$")
    
    gfLetraColuna = lTexto(1)
End Function

2. Abra todas as planilhas que gostaria de unificar;
3. Vá na guia Desenvolvedor e no botão Macros, selecione PERSONAL.XLSB!lsUnificarPanilhas e clique em Executar;

4. Informe a planilha que receberá a união das planilhas e clique em OK;

5. Aguarde o término do processamento. Todos os dados da primeira planilha ativa de cada arquivo serão copiados e as planilhas fechadas, exceto a planilha de destino.