Sub teste()
'Desativa a atualização de tela
Application.ScreenUpdating = False
'Abrir pasta 2
Workbooks.Open Filename:="C:UsersANDERSONDesktopPasta2.xlsx"
'Ativar pasta 2
Windows("Pasta2.xlsx").Activate
'Procura pasta 2
valor = Application.WorksheetFunction.VLookup("teste", ActiveWorkbook.Sheets("Plan1").Range("A1:C12"), 2, False)
'Mostra o valor
MsgBox valor
'salva a pasta 2
ActiveWorkbook.Save
'fecha a pasta 2
ActiveWorkbook.Close
'Ativa a atualização de tela
Application.ScreenUpdating = True
End Sub
Sub teste2()
'Desativa a atualização de tela
Application.ScreenUpdating = False
'Abrir pasta 2
Workbooks.Open Filename:="C:UsersANDERSONDesktopPasta2.xlsx"
'Ativar pasta 2
Windows("Pasta2.xlsx").Activate
'Procura pasta 2
valor = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets("Plan1").Range("A1").Value, ActiveWorkbook.Sheets("Plan1").Range("A1:C12"), 2, False)
'Mostra o valor
MsgBox valor
'salva a pasta 2
ActiveWorkbook.Save
'fecha a pasta 2
ActiveWorkbook.Close
'Ativa a atualização de tela
Application.ScreenUpdating = True
End Sub
Sub teste3()
'Desativa a atualização de tela
Application.ScreenUpdating = False
'Abrir pasta 2
Workbooks.Open Filename:="C:UsersANDERSONDesktopPasta2.xlsx"
'Ativar pasta 2
Windows("Pasta2.xlsx").Activate
'Procura pasta 2
valor = Application.WorksheetFunction.VLookup(ThisWorkbook.Sheets("Plan1").Range("A1").Value, ActiveWorkbook.Sheets("Plan1").Range("A1:C12"), 2, False)
'Escreve o resultado na Pasta 1
ThisWorkbook.Sheets("Plan1").Range("B1").Value = valor
'salva a pasta 2
ActiveWorkbook.Save
'fecha a pasta 2
ActiveWorkbook.Close
'Ativa a atualização de tela
Application.ScreenUpdating = True
End Sub
https://drive.google.com/file/d/1oMvSQJDhTxOOjRurZhYAeGk0x_wlIr70/view?usp=sharing
https://youtu.be/hUUq7ZEnuzU
Postado : 31/01/2020 10:05 am