Copiar e colar várias abas em uma única aba da mesma planilha uma abaixo da outra

[Douglas Phizato]

Estou com uma planilha que tem várias abas, gostaria de colocá-las em uma única aba na mesma pasta de trabalho chamada MATRIZ que eu criei.

Como crio essa macro, uma vez que o range de cada aba vária cada dia.

Projeto.xlsx

[Visitante]

Douglas, para facilitar quem possa te ajudar sugiro que você disponibilize aqui no fórum uma amostra do seu arquivo, com 2 ou 3 planilhas com dados e também a planilha resumo (com os dados das demais planilhas),

[Douglas Phizato]

Está editado! Tão simples que é complicado );

[Visitante]

Veja se atende.

Sub PlanMatriz() Dim ws As Worksheet, LRo As Long, LRd As Long  LRo = Sheets("MATRIZ").Cells(Rows.Count, 1).End(xlUp).Row  Sheets("MATRIZ").Range("A2:E" & LRo).ClearContents  For Each ws In ThisWorkbook.Worksheets   If ws.Name <> "MATRIZ" Then    LRo = ws.Cells(Rows.Count, 1).End(xlUp).Row     With Sheets("MATRIZ")      LRd = .Cells(Rows.Count, 1).End(xlUp).Row      .Cells(LRd + 1, 1).Resize(LRo - 1, 5).Value = ws.Range("A2:E" & LRo).Value     End With   End If  Next wsEnd Sub

[isapcsd]

Olá
 

edit: Não se esqueça que a aba que ira ser a matriz (onde todas as outras estarão reunidas) deverá ser a Plan23, portanto a aba deverá estar com esse nome para a macro funcionar;

 

veja se a macro abaixo lhe ajuda:

Sub juntarabas()' desabilita atualização da telaApplication.ScreenUpdating = False' desabilita mensagensApplication.DisplayAlerts = False' dimensiona variávelDim LIN As Integer' copia o conteúdo da aba seguinte e apaga a abaDoSheets("Plan23").Select' define a primeira linha vazia da aba atualLIN = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row' vai para a aba seguinteActiveSheet.Next.Select' copia o conteúdo necessárioRange("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.Copy' volta para a aba inicial e colaActiveSheet.Previous.SelectRows(LIN).Insert Shift:=xlDown' vai para a aba copiada e deleta elaActiveSheet.Next.SelectActiveSheet.Delete' limpa a variável LINLIN = 0' repete o procedimento até haver apenas 1 abaLoop Until Worksheets.Count = 1'apaga área de transferênciaApplication.CutCopyMode = False' habilita atualização da telaApplication.ScreenUpdating = False' habilita mensagensApplication.DisplayAlerts = FalseRange("A1").SelectEnd Sub