Guru do Excel e Power BI

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:="")
  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
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
  End If
   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
End Sub