Excel Erro com execução Send keys

[xandymarinho]

Bom dia Pessoal

 

Já tenho um VBA que uso a bastante tempo para copiar dados de outra planilha

 

Agora preciso de uma macro para a partir da célula que o código antigo para, ele selecione os dados e copie, pois colo essa informação no WhatsApp

 

Estou tentando fazer manualmente com send keys, mas as vezes funciona e as vezes não

 

Estou fazendo assim

 

Sub Copiar()

     
     
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+{RIGHT}"
        Application.SendKeys "+^{UP}"
        Application.SendKeys "+^{UP}"
       Application.SendKeys "+^{UP}"
  
Call SendKeys("{NUMLOCK}", True)
      
    
End Sub

 

Como podem ver está bem manual, ele deslocando 9 vezes pra direita com shift e depois 2 vezes pra cima com shift+control

 

[xandymarinho]

Viu adicionar o arquivo para que entendam melhor

 

No DASH quando você seleciona alguma das promotoras, os dados são atualizados e a celula ativa é a ultima, o que preciso é que desse final até em cima seja selecionado, pois copio e colo no WhatsApp

ANALISE RELATORIO VENDAS JAN_23.rar

[Scofieldgyn]

@xandymarinho

 

segue:

adicionei um limpar na planilha 3 Range("G44:P") antes da macro ser executada ok.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim UltLin As Long

Application.ScreenUpdating = False
Application.EnableEvents = True

If Not Intersect(Target, Range("A4")) Is Nothing Then

Planilha3.Select
UltLin = Cells(Rows.Count, "G").End(xlUp).Row
Planilha3.Range("G44:P" & UltLin).ClearContents

Planilha2.Select
UltLin = Cells(Rows.Count, "K").End(xlUp).Row
Planilha2.Range("K4:T" & UltLin).Copy
Planilha3.Range("G44").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

Planilha3.Select

PivotTables("Tabela dinâmica2").PivotCache.Refresh

Application.ScreenUpdating = True

End If

End Sub

 

[xandymarinho]

4 horas atrás, Scofieldgyn disse:

@xandymarinho

 

segue:

adicionei um limpar na planilha 3 Range("G44:P") antes da macro ser executada ok.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim UltLin As Long

Application.ScreenUpdating = False
Application.EnableEvents = True

If Not Intersect(Target, Range("A4")) Is Nothing Then

Planilha3.Select
UltLin = Cells(Rows.Count, "G").End(xlUp).Row
Planilha3.Range("G44:P" & UltLin).ClearContents

Planilha2.Select
UltLin = Cells(Rows.Count, "K").End(xlUp).Row
Planilha2.Range("K4:T" & UltLin).Copy
Planilha3.Range("G44").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

Planilha3.Select

PivotTables("Tabela dinâmica2").PivotCache.Refresh

Application.ScreenUpdating = True

End If

End Sub

 

Opa amigo, muito obrigado, mas não estou conseguindo fazer ela funcionar, o que pode ser? copio e colo o codigo lá e ele manda salvar e não funciona

[Scofieldgyn]

@xandymarinho

 

Não entendi, aparece algum erro?

 

 

[xandymarinho]

5 horas atrás, Scofieldgyn disse:

@xandymarinho

 

Não entendi, aparece algum erro?

 

 

Opa amigo, funcionou, eu que estava colocando errado....muito obrigado