Pesquisar na Comunidade

Olá galera, gostaria da ajuda de vocês. Preciso preencher duas tabelas iguais a que está no print a seguir, o problema é que gostaria de fazer isso com a ajuda do VBA, no caso eu tenho na planilha "Teste" uma lista de 70000 palavras e preciso que a partir de uma tabela que está preenchida o código verifique quais palavras ocorrem na lista independente de serem maiusculas ou minusculas, converta tudo para minuscula e cole a palavra na outra tabela vazia de modo que vá preenchendo a tabela vazia e eliminando as palavras lá da lista. Poderiam me ajudar? (A tabela a seguir começa na coluna A e vai até a coluna F) Essa é a tabela de testes

Boa tarde! 😀 Estou utilizando um código VBA para consolidação de planilhas afim de enviar um relatório semanal. Preciso de ajuda pois o código está buscando os dados certos, porém eu não preciso que me retorne a planilha inteira e sim apenas da A6 até a coluna E6 em todas as planilhas, e apenas os dados contidos, não precisa vim a formatação original pois se preciso for, formato depois do jeito que eu precisar. Tentei usar o Offset mas está dando erro "tempo de execução 9". Em anexo coloquei o print do modelo da planilha que será consolidada. Código Utilizado: Option Explicit Private Sub btExecuta_Click() Application.ScreenUpdating = False 'Definição das variáveis '-------------------------------------- Dim W As Worksheet Dim WNew As Workbook Dim ArqParaAbrir As Variant Dim A As Integer Dim NomeArquivo As String 'Capturar arquivos para tratamento '--------------------------------------- ArqParaAbrir = Application.GetOpenFilename("Arquivo do Excel (*.xlsm), *.xl*", _ Title:="Escolha o arquivo a ser importado", _ MultiSelect:=True) If Not IsArray(ArqParaAbrir) Then If ArqParaAbrir = "" Or ArqParaAbrir = False Then MsgBox "Processo abortado, nenhum arquivo escolhido", vbOKOnly, "Processo abortado" Exit Sub End If End If 'Começa a importação dos dados '------------------------------------- Set W = Sheets("CONSOLIDADO") W.UsedRange.EntireColumn.Delete W.Select 'Loop para importação dos arquivos '-------------------------------------- For A = LBound(ArqParaAbrir) To UBound(ArqParaAbrir) NomeArquivo = ArqParaAbrir(A) Application.Workbooks.Open (NomeArquivo) Set WNew = ActiveWorkbook ActiveSheet.Range("a6").CurrentRegion.Select Selection.Copy Destination:=W.Cells(W.Rows.Count, 1).End(xlUp).Offset(1, 0) Application.DisplayAlerts = False ActiveWorkbook.Close savechanges:=False Application.DisplayAlerts = True W.Cells(W.Rows.Count, 1).End(xlUp).Offset(1, 0).Select Next A Application.ScreenUpdating = True MsgBox "Processo concluído. Arquivos copiados..." End Sub **** Desde já agradeço.