Excel Reunir várias planilhas em uma só com VBA

[Martti]

Bom dia senhores.

Recorro mais uma vez ao conhecimento dos colegas.

Passei a receber um arquivo em excel que foi convertido de um PDF.

Essas conversões deixa a desejar, pois muitas vezes quebram tabelas, linhas e tabulações.

O arquivo original em PDF possui 159 páginas, o que gera um arquivo .xls com 159 planilhas.

Preciso juntar todas as planilhas em uma só, em sequencia, para organizar os dados e tabelas para gerar os relatórios.

Em anexo envio um arquivo com uma situação semelhante.

Desde já agradeço pela ajuda.

 

Relacao-das-ruas-agupadas-por-bairro-em_01_12_22.zip

[Midori]

@Martti Algumas células estão mescladas, a macro vai remover a mescla e copiar os dados para outra aba. Crie uma aba com o nome Tabela e execute a macro de teste. Se trazer os dados no formato certo execute a última.

 

Sub Teste()
    Call CopiaRelatorio( _
        ThisWorkbook.Sheets("Table 1"), _
        ThisWorkbook.Sheets("Tabela"))
End Sub

Sub CopiaRelatorio(Origem As Worksheet, Destino As Worksheet)
    Dim LinAba  As Long
    Dim LinTbl  As Long
    Dim Colunas As Integer
    Dim Bairro  As String
    
    Colunas = Origem.UsedRange.Columns.Count
    Origem.Columns(1).Resize(, Colunas).MergeCells = False
    
    For LinAba = 1 To Origem.UsedRange.Rows.Count
        If Origem.Cells(LinAba, "A").Font.Bold = True Then
            Bairro = Origem.Cells(LinAba, "A")
        Else
            LinTbl = Destino.[A1].CurrentRegion.Rows.Count + 1
            Destino.Cells(LinTbl, "A") = Bairro
            Destino.Cells(LinTbl, "B").Resize(, Colunas - 1).Value = _
                Origem.Cells(LinAba, "A").Resize(, Colunas).Value
        End If
    Next LinAba
End Sub

 

Sub JuntarRelatorios()
    Dim Destino As Worksheet
    Dim Aba     As Worksheet
    
    Set Destino = ThisWorkbook.Sheets("Tabela")
    
    For Each Aba In ThisWorkbook.Worksheets
        If Aba.Name <> Destino.Name Then
            Call CopiaRelatorio(Aba, Destino)
        End If
    Next Aba
End Sub

 

[OreiaG]

Sub CopiaTodas()
 Dim k As Long
  Application.ScreenUpdating = False
  Sheets.Add(before:=Sheets(1)).Name = "Sumário"
  With Sheets("Sumário")
   For k = 2 To 10 'Sheets.Count - 1
    Sheets(k).UsedRange.Copy .Cells(.Rows.Count, 1).End(3)(2)
   Next k
   .Cells.WrapText = False
   .Cells.Columns.AutoFit
  End With
End Sub

 

obs. para efeitos de testes, coloquei para copiar as primeiras 10 planilhas; se você quiser testar com mais planilhas, por exemplo com 50, substitua o número 10 por 50 (antes de efetuar cada teste exclua a planilha Sumário); se o resultado for satisfatório então remova o número 10 e o apóstrofo, aí o código irá copiar TODAS as planilhas >>> a linha do código deverá ficar assim >>> For k = 2 To Sheets.Count - 1

[Martti]

@Midori e @OreiaG muito obrigado por me auxiliarem nesse problema.

Apenas indiquei a resposta do Midori como solução porque respondeu anteriormente, mas

ambas as respostas resolvem prontamente a situação.

 

Agradeço por compratilharem vosso tempo e vosso conhecimento.

 

[Midori]

@Martti Se a outra solução também serve então ela é melhor.

 

Achei que gostaria de criar uma tabela com os dados em cada coluna: Bairro, Rua, etc. Mas como era algo mais simples então acho que não devia usar o meu código que perde em processamento com um loop que coloquei só pra isso.

[Martti]

@Midorisem modéstia, ambas colaborações resolvem meu problema, de modos diferentes, mas atingem o mesmo propósito.

Há situações onde preciso de tabela organizada por colunas e outras situações onde só uma coluna resolve o ÍNDICE+CORRESP.

Por isso agradeço aos dois colegas por compartilharem do conhecimento, mais cebeças pensam melhor do que uma.

Hoje ou amanhã devo postar outra situação para totalizar 3 planilhas diferentes...

Começo de ano, com novas filiais e/ou terceirizados é uma tempestade de planilhas ainda sem padronização.

E não sou programador, mas a necessidade é a mãe da criatividade...