brunoramosd

obrigado meu mestre.

Vou colocar em um drive aqui pra você a tabela, acho que consegues entender melhor com os dados. Agradeço D+ conseguir ajustar, estou com prazo super apertado com o cliente, e o negócio não vai, batendo aquele desespero uhauahua. https://drive.google.com/file/d/11NzyfJI8daM5wL-iJvzc0hAbwIiYpOny/view?usp=sharing

Então, é que eu preciso identificar na "Base Geral", se tem algum espaço para adicionar na "Tabela Saturno" Ou seja: Na Tabela Saturno eu tenho, 1, 2, 4, 5, 6..... Quero identificar se na Base Geral eu encontro o 3 Se eu encontra o 3 ele vai levar para a Tabela Agrupada o 1, 2 (da Tabela Saturno) + 3 (Base Geral). Conseguiu pegar a rotina?

A que tem mais dados é a planilha "Base Geral", ela tem uns 60k linhas e a "Tabela Saturno" uns 6k linhas e a "Tabela Agrupada" é a tabela final criada com a varredura da Tabela Saturno na Base Geral.

Estou com um problema quando vou tentar executar meu código pelo F5 ele trava, porém quando eu rodo no F8 ele funciona. O meu código ele é para fazer o seguinte: Tabela 1: lista de CEPS tenho 1 inicial e 1 final 2 colunas (5.800 LINHAS) Tabela 2: Outra tabela com mais CEPS 1 inicial e 1 final 2 colunas (33.204 LINHAS) A ideia é identificar os CEPS faltantes na tabela 2 e montar uma nova tabela 3 com essas duas tabelas. Fiz o código abaixo: --------------------------------------------------------- Sub Agrupa_CEPS() Application.ScreenUpdating = False Dim CEPINICIAL_BGGERAL Dim CEPINIOLD_BGGERAL Dim CEPFINAL_BGGERAL Dim CEPINICIAL_BGSATURNO Dim CEPFINAL_BGSATURNO Dim CEPINICIALNEXT_BGSATURNO 'Copia Cabeçalho padrão Saturno Sheets("Tabela Saturno").Select Range("A1").Select Range(Selection, Selection.End(xlToRight)).Copy Sheets("Tabela Agrupada").Select Range("A1").PasteSpecial Range("A1").Value = "Nome Base" Range("A1").Select Application.CutCopyMode = False 'Inicia varredura dos CEPS pela Saturno Sheets("Base Geral").Select Range("C2").Select Sheets("Tabela Saturno").Select Range("C2").Select Do While ActiveCell <> "" CEPINICIAL_BGSATURNO = ActiveCell.Offset(0, 0).Value CEPINICIALNEXT_BGSATURNO = ActiveCell.Offset(1, 0).Value CEPFINAL_BGSATURNO = ActiveCell.Offset(0, 1).Value ActiveCell.EntireRow.Copy Sheets("Tabela Agrupada").Select ActiveCell.Offset(1, 0).PasteSpecial Application.CutCopyMode = False Do While ActiveCell <> "" Sheets("Base Geral").Select CEPINICIAL_BGGERAL = ActiveCell.Offset(0, 0).Value If ActiveCell.Row = 2 Then CEPINIOLD_BGGERAL = ActiveCell.Offset(0, 0).Value - 1 Else CEPINIOLD_BGGERAL = ActiveCell.Offset(-1, 0).Value End If CEPFINAL_BGGERAL = ActiveCell.Offset(0, 1).Value If CEPINICIAL_BGGERAL > CEPFINAL_BGSATURNO And CEPINIOLD_BGGERAL < CEPINICIAL_BGGERAL And CEPFINAL_BGGERAL < CEPINICIALNEXT_BGSATURNO Then Sheets("Base Geral").Select ActiveCell.EntireRow.Copy Sheets("Tabela Agrupada").Select ActiveCell.Offset(1, 0).PasteSpecial Application.CutCopyMode = False End If Sheets("Base Geral").Select ActiveCell.Offset(1, 0).Select Loop Sheets("Base Geral").Select Range("C2").Select Sheets("Tabela Saturno").Select ActiveCell.Offset(1, 0).Select Loop Application.ScreenUpdating = True MsgBox "Finalizado" End Sub --------------------------------------------------- Poderiam me ajudar por gentileza? Obrigado