Este fórum está sendo desativado

[brunoalmeida123]

Pessoal, boa tarde!

Estou com dificuldade em juntar abas do meu arquivo em Excel.

1- Nem sempre meus arquivos terão a mesma quantidade de abas.

2 - Minha intenção é juntar as planilhas em blocos. Ex: Juntar as planilhas do Bloco C - do C001 ao C197

Quebrei os arquivos de um txt com diversos registros em Excel, e agora para poder exportar na ordem correta preciso juntar algumas dessas planilhas. Ex Planilhas 0000 até 0990, C001 até C197 e assim consequentemente nos blocos D, E e etc.

3 - Estou utilizando um código que copia os dados da planilha seguinte na planilha C001 e depois deleta a planilha. Ex: copia os dados da planilha C100 para a planilha C001 e depois deleta a planilha C100.

4- O problema é que não consigo para meu loop até chegar na planilha C197, ele vai fazendo o procedimento até o final das planilhas.

5- O Worksheets.Count não esta servindo para mim e gostaria de uma ajuda para o loop parar quando chegar em determinada planilha.

6 - Se em vez de ele deletar até sobrar 1 planilha, o loop poderia continuar o processo de juntando outro bloco ajudaria bastante. Ex: Após juntar todas as planilhas do bloco C, juntar as planilhas do bloco D.

' desabilita atualização da tela
Application.ScreenUpdating = False
' desabilita mensagens
Application.DisplayAlerts = False
' dimensiona variável
Dim LIN As Integer

' copia o conteúdo da aba seguinte e apaga a aba
Do
Sheets("C001").Select
' define a primeira linha vazia da aba atual
LIN = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' vai para a aba seguinte
ActiveSheet.Next.Select
' copia o conteúdo necessário
Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.Copy
' volta para a aba inicial e cola
ActiveSheet.Previous.Select
Rows(LIN).Insert Shift:=xlDown
' vai para a aba copiada e deleta ela
ActiveSheet.Next.Select
ActiveSheet.Delete
' limpa a variável LIN
LIN = 0
' repete o procedimento até haver apenas 1 aba
Loop Until Sheets("D001").Select
'apaga área de transferência
Application.CutCopyMode = False
' habilita atualização da tela
Application.ScreenUpdating = False
' habilita mensagens
Application.DisplayAlerts = False
Range("A1").Select
End Sub

[osvaldomp]

Olá, @brunoalmeida123

2 - Minha intenção é juntar as planilhas em blocos. Ex: Juntar as planilhas do Bloco C - do C001 ao C197
Se entendi corretamente, você quer manter a planilha C001 e replicar nela os dados das planilhas C002 até C197, e quer excluir as planilhas C002 a C197. É isso?


6 - Se em vez de ele deletar até sobrar 1 planilha, o loop poderia continuar o processo de juntando outro bloco ajudaria bastante. Ex: Após juntar todas as planilhas do bloco C, juntar as planilhas do bloco D.
Se a sua resposta para a pergunta acima for "sim", qual é a próxima etapa? Você quer juntar todas as planilhas iniciadas por "D" na planilha C001, ou quer juntá-las na planilha D001?
Porém, se a sua resposta for "não", então explique.

#
Ainda,
1. os dados ocupam quais colunas? De A até qual coluna?
2. informe com exatidão como são os nomes das planilhas a serem agrupadas. Ex: C001 a C197, D001 a D???, ...

[brunoalmeida123]

Ola, @osvaldomp

Respondendo as suas perguntas:

Se entendi corretamente, você quer manter a planilha C001 e replicar nela os dados das planilhas C002 até C197, e quer excluir as planilhas C002 a C197. É isso?
R: SIM

Se a sua resposta para a pergunta acima for "sim", qual é a próxima etapa? Você quer juntar todas as planilhas iniciadas por "D" na planilha C001, ou quer juntá-las na planilha D001?
R: QUERO JUNTAR AS PLANILHAS QUE COMEÇAM COM D NA D001

1. os dados ocupam quais colunas? De A até qual coluna?
R: Cada planilha tem dados que ocupam colunas diferentes. Anexei o arquivo para verificar.

2. informe com exatidão como são os nomes das planilhas a serem agrupadas. Ex: C001 a C197, D001 a D???, ...
R: C001 a C197, D001 a D190. Anexei o arquivo para poder verificar como estão as planilhas e os dados.

Desde já, agradeço a atenção.

[osvaldomp]

Olá, @brunoalmeida123 .
Veja se o código abaixo pode ajudar.

funcionamento:
1. o código irá utilizar a Planilha1, já existente no seu arquivo, como planilha auxiliar. Na coluna A
serão listados pelo código os nomes das planilhas e, para facilitar a sua verificação dos resultados, o código
irá lançar na coluna B o texto "copiar/excluir" referente a cada planilha da coluna A a ser excluída e que antes
terá os seus dados replicados na planilha receptora correspondente.
As células da coluna B correspondentes às planilhas receptoras permanecerão vazias.
No arquivo que você postou serão 8 receptoras e 29 excluídas.

2. ainda para facilitar a sua verificação dos resultados, deixei comentado o comando que exclui as planilhas.
Os dados serão replicados mas as planilhas não serão excluídas.
Então, após verificar que os resultados são os esperados, reabra o arquivo e descomente o comando abaixo.
' Sheets(.Cells(k + m + 1, 1).Value).Delete

3. ao iniciar a réplica dos dados de uma nova planilha o código irá colocar na coluna A o nome da planilha; essa
operação poderá ser excluída eliminando-se o comando abaixo.
Sheets(.Cells(k, 1).Value).Cells(Rows.Count, 1).End(3)(2) = .Cells(k + m + 1, 1)
#
S

Código: Selecionar todos

ub ConsolidaEExcluiPlans()
 Dim ws As Worksheet, LR As Long, LCo As Long, LRo As Long, k As Long, m As Long
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With Sheets("Planilha1")
   .[A:B].Clear
   .[A:A].NumberFormat = "@"
   For Each ws In ThisWorkbook.Worksheets
    If Left(ws.Name, 4) <> "Plan" Then .Cells(Rows.Count, 1).End(3)(2) = CStr(ws.Name)
   Next ws
   LR = .Cells(Rows.Count, 1).End(3).Row
   .Range("A2:A" & LR).Sort Key1:=.[A2], Order1:=xlAscending
   For k = 2 To LR - 1
    Do While Left(.Cells(k, 1), 1) = Left(.Cells(k + m + 1, 1), 1)
     LRo = Sheets(.Cells(k + m + 1, 1).Value).Cells(Rows.Count, 1).End(3).Row
     LCo = Sheets(.Cells(k + m + 1, 1).Value).Cells(1, Columns.Count).End(1).Column
     Sheets(.Cells(k, 1).Value).Cells(Rows.Count, 1).End(3)(2) = .Cells(k + m + 1, 1)
     Sheets(.Cells(k + m + 1, 1).Value).Range("A2", Sheets(.Cells(k + m + 1, 1).Value).Cells(LRo, LCo)).Copy
     Sheets(.Cells(k, 1).Value).Cells(Rows.Count, 1).End(3)(2).PasteSpecial xlValues
     .Cells(k + m + 1, 2) = "copiar/excluir"
'     Sheets(.Cells(k + m + 1, 1).Value).Delete
     m = m + 1
    Loop
    k = k + m: m = 0
   Next k
  End With
End Sub