Adriano_Aragão

Boa tarde! Meu nome é Adriano e eu não sou programador de linguagem nenhuma. Sou um entusiasta que procuro fazer algumas macros que facilitem algumas tarefas do meu dia a dia. Com a ajuda de Inteligências Artificiais eu consegui fazer dois códigos em VBA para copiar um intervalo de dados da planilha1 para a planilha2. O intervalo de dados copiado deve atender a solicitação do usuário. O primeiro código está funcionando bem, porém é muito lento, faz a cópia linha a linha; No segundo código está bem rápido, inicia a cópia com a data solicitada pelo usuário porém copia todas as datas seguintes. A base de dados que eu quero filtrar, por vezes, contém mais de 30.000 linhas. Os dados de origem estão na coluna A da planilha1; Eu quero encontrar e copiar, no intervalo de células preenchidas da planilha1, um intervalo de células que contenham a data solicitada pe usuário. Uma vez encontrado e copiado esse intervalo de dados (intervalo que contenha a data solicitada pelo usuário) colar na na célula A1 da planilha2. Alguém poderia verificar para mim os códigos e sugerir correções? Fico grato. Código 1: Sub CopiaCola() Dim i As Range Dim PrimeiraLinha As Integer Dim LinOrigem As Integer Dim LinDestino As Integer LinOrigem = 1 LinDestino = 1 Planilha2.Cells.ClearContents ' Defina a data que você deseja procurar (no formato de texto) Dim dataProcurada As String dataProcurada = InputBox("Digite a data que deseja procurar (formato: MM/DD)") Set i = Planilha1.Range("A:A").Find(dataProcurada) PrimeiraLinha = i.Row If Not i Is Nothing Then ' Verificar se o dado foi encontrado Do Planilha1.Range("A" & i.Row).EntireRow.Copy Planilha2.Range("A" & LinDestino) LinDestino = LinDestino + 1 Set i = Planilha1.Range("A:A").FindNext(i) LinOrigem = LinOrigem + 1 Loop While Not i Is Nothing And PrimeiraLinha <> i.Row Else MsgBox "A data '" & dataProcurada & "' não foi encontrada na Planilha1.", vbExclamation End If End Sub Código 2: Sub CopiaCola() Dim i As Range Dim PrimeiraLinha As Integer Dim UltimaLinha As Integer PrimeiraLinha = 1 Planilha2.Cells.ClearContents ' Defina a data que você deseja procurar (no formato de texto) Dim dataProcurada As String dataProcurada = InputBox("Digite a data que deseja procurar (formato: MM/DD)") Set i = Planilha1.Range("A:A").Find(dataProcurada) If Not i Is Nothing Then ' Verificar se o dado foi encontrado PrimeiraLinha = i.Row UltimaLinha = Planilha1.Cells(i.Row, "A").End(xlDown).Row Planilha1.Range("A" & PrimeiraLinha & ":A" & UltimaLinha).EntireRow.Copy Planilha2.Range("A1") Else MsgBox "A data '" & dataProcurada & "' não foi encontrada na Planilha1.", vbExclamation End If End Sub