Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Executar macro auto...
 
Notifications
Clear all

Executar macro automaticamente

 
2024 - VBA & Macros
6 Posts
3 Usuários
0 Reactions
1,394 Visualizações
RSS
 Mario L Cremonese
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Caros amigos,
Tenho a macro abaixo, a qual é executada através de um botão de comando. Gostaria que a mesma rodasse automaticamente sempre que a célula "R3" recebesse o valor "GRAVAR", colocando para tanto a condição no evento "Private Sub Worksheet_Change(ByVal Target As Range" da planilha ativa. Já tentei de várias maneiras e não consegui.
Se algum amigo puder ajuda ficarei imensamente grato.
Sub Gravar()
Application.ScreenUpdating = False
Sheets("RESUMO GERAL").Activate
i = Sheets("RESUMO GERAL").Range("A50000").Rows.End(xlUp).Row + 1
Cells(i, "A") = Sheets("APURACAO").Cells(4, "D")
Cells(i, "B") = Sheets("APURACAO").Cells(2, "V")
Cells(i, "C") = Sheets("APURACAO").Cells(10, "F")
Cells(i, "D") = Sheets("APURACAO").Cells(3, "V")
Cells(i, "E") = Sheets("APURACAO").Cells(10, "J")
Cells(i, "F") = Sheets("APURACAO").Cells(14, "F")
Cells(i, "G") = Sheets("APURACAO").Cells(14, "J")
Cells(i, "H") = Sheets("APURACAO").Cells(16, "F")
Cells(i, "J") = Sheets("APURACAO").Cells(19, "F")
Cells(i, "K") = Sheets("APURACAO").Cells(21, "F")
Cells(i, "L") = Sheets("APURACAO").Cells(22, "F")
Cells(i, "M") = Sheets("APURACAO").Cells(24, "F")
Cells(i, "O") = Sheets("APURACAO").Cells(22, "J")
Cells(i, "P") = Sheets("APURACAO").Cells(12, "F")
Cells(i, "Q") = Sheets("APURACAO").Cells(4, "V")
Cells(i, "R") = Sheets("APURACAO").Cells(12, "J")
Cells(i, "S") = Sheets("APURACAO").Cells(6, "V")
Cells(i, "T") = Sheets("APURACAO").Cells(8, "V")
Cells(i, "U") = Sheets("APURACAO").Cells(26, "F")
Cells(i, "V") = Sheets("APURACAO").Cells(26, "j")
Cells(i, "W") = Sheets("APURACAO").Cells(10, "v")
End If
Sheets("APURACAO").Select
Range("D4").Select
End Sub

 
Postado : 22/02/2014 4:47 am
 Fabiosp
(@fabiosp)
Posts: 291
Reputable Member
 

Bom dia caro colega Mario L Cremonese

Acho que você precisa é disso.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Sheets("Sheet1").Range("R3").Value = "gravar" Then gravar
End Sub

Eu não entendo quase nada de VBA, porém já passei por problema parecido e um colega do fórum (Mestre alexandrevba) me ensinou este código.
Você só precisa adaptar a sua planilha.

Abraços.

 
Postado : 22/02/2014 5:19 am
 Mario L Cremonese
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Caro Fabio,
Agradeço por sua gentileza, mas não funcionou.
A planilha ativa é a "APURACAO", e a que receberá os valores é a "RESUMO GERAL".
Ambas são acessadas pelo nome da planilha e não por planilha 1, 2, 3 etc.
De qualquer maneira, fica gravado o meu agradecimento.

 
Postado : 22/02/2014 7:01 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Coloque na aba que pretende :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sTexto
    
    If Not Intersect(Target, Range("R3")) Is Nothing Then
        
        'Não diferencia maiuscula de minusculas
        sTexto = UCase(Target.Value)
         
        'Se quiser diferenciar maiuscula de minuscula troque
        'sTexto = Target.Value
        
        If sTexto = "GRAVAR" Then
            
            Call Gravar
    
        Else
            Exit Sub
        End If
        
   End If
   
End Sub

[]s

 
Postado : 22/02/2014 9:09 am
 Mario L Cremonese
(@mario-l-cremonese)
Posts: 26
Eminent Member
Topic starter
 

Prezados amigos,
Vejam outra maneira que encontrei para o problema citado.
Private Sub Worksheet_Change(ByVal Target As Range)
Range("R3").Activate
If Range("R3") = "GRAVAR" Then
Call Gravar
End If
End Sub
Abraços

 
Postado : 24/02/2014 12:14 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Caso seja necessário reabrir o tópico, o autor poderá enviar uma MP para um dos moderadores solicitando o desbloqueio.

 
Postado : 24/02/2014 1:47 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico