Executar macro automaticamente

2024 - VBA & Macros

Post Recente por Fernando Fernandes 11 anos atrás

6 Posts

3 Usuários

0 Reactions

1,402 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

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

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