O_Aprendiz

Esta postagem está presente em outros fóruns, através dos seguintes links: http://planilhando.com.br/forum/communi ... ost-128783 https://www.hardware.com.br/comunidade/v-t/1541269/#post8485667 https://comunidade.databinteligencia.com.br/viewtopic.php?p=69193&sid=e91ed9b35db916566ee8a86c07b2600d#p69193

@AfonsoMira Estou anexando os arquivos. O código mudou um pouco, mas o objetivo é o mesmo. Arquivo 2.xlsx Arquivo 1.xlsx

Olá! Alguém que seja expert em VBA e que tenha alguns minutinhos consegue analisar o código e dar um help?! Eu preciso que esta macro compare os valores de uma célula em uma planilha(1) com uma coluna em outra planilha(2) e caso os valores constem, que ele copie os valores para a mesma linha da planilha(1) e se não nessa comparação o valor não estiver na planilha(2), que ele copie determinadas células no final da tabela. Fiz vários testes aqui, mas chega em determinado ponto que a macro pula "misteriosamente" para outra macro do mesmo arquivo. rs Se alguém já tiver algum modelo assim e puder compartilhar também, será muito bem vindo! Muito obrigado! Sub Procura() Dim valor1 As Variant Dim valor2 As Variant Dim arquivo_origem As Variant Dim arquivo_destino As Variant Dim posicao1 As Range Dim posicao2 As Range Dim planilhadestino As Workbook Dim planilhaorigem As Workbook Dim guiadestino As Worksheet Dim guiaorigem As Worksheet Dim planilhaativa As Worksheet Dim ultimalinhaplan1 As Long Dim ultimalinhaplan2 As Long Dim variavel2 As Long Dim variavel3 As Long Dim valorprocurado As Range Set planilhaorigem = ThisWorkbook: Set guiaorigem = planilhaorigem.ActiveSheet 'guiadestino = Worksheets("Novo") 'guiaorigem = Worksheets("Acompanhamento") Set arquivo_origem = ThisWorkbook.ActiveSheet arquivo_destino = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Escolha o arquivo:") If arquivo_destino = False Then MsgBox "Erro!": Exit Sub Set planilhadestino = Workbooks.Open(arquivo_destino) Application.ScreenUpdating = False planilhadestino.Activate Set guiadestino = Sheets("Planilha1") Set planilhaativa = guiadestino planilhaativa.Activate If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If ultimalinhaplan1 = guiadestino.Cells(Rows.Count, 1).End(xlUp).Row If ultimalinhaplan1 < 2 Then MsgBox "Erro!": Exit Sub Set valorprocurado = Worksheets("Planilha1").Range("D2:D1000") planilhaorigem.Activate With guiaorigem 'On Error Resume Next If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If On Error GoTo 0 If .[C2] = "" Then ultimalinhaplan2 = 1 Else: ultimalinhaplan2 = .Cells(Rows.Count, 1).End(xlUp).Row guiaorigem.Activate Range("G8").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Select If ActiveCell = "valorprocurado" Then .Range("E9:G" & ultimalinhaplan1 & ",J9:J" & ultimalinhaplan1 & ",T9:T" & ultimalinhaplan1).Copy planilhadestino.Activate guiadestino.Activate .Range("D9:F" & ultimalinhaplan1 & ",H9:H" & ultimalinhaplan1 & ",R9:R" & ultimalinhaplan1).ClearContents .Range("D9:F" & ultimalinhaplan1 & ",H9:H" & ultimalinhaplan1 & ",R9:R" & ultimalinhaplan1).Paste ElseIf ActiveCell = "" Then End If Loop .Range("A1").Select ' retorna para o inicio da coluna .Range("E9:G" & ultimalinhaplan1 & ",J9:J" & ultimalinhaplan1 & ",T9:T" & ultimalinhaplan1).Copy .Cells(ultimalinhaplan2 + 1, 1).PasteSpecial xlValues variavel3 = .Cells(Rows.Count, 1).End(3).Row End With Exit Sub errH: MsgBox "Erro!" End Sub