Execução automática...
 
Notifications
Clear all

Execução automática de macro

3 Posts
2 Usuários
0 Reactions
882 Visualizações
(@denilsonsl)
Posts: 84
Trusted Member
Topic starter
 

Boa tarde Galera.

Eu tenho esse código abaixo em uma planilha, mas ao escrever na célula a letra R, preciso que o código execute automaticamente.

Alguem sabe me dizer o que eu fiz de errado nesse codigo?

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

If plan1.range("E2:E30000").value = "R" then

    Plan10.Range("A3:Z200").ClearContents 'comando que limpa as linhas da planilha espelho
    ultimalinha = Plan1.Cells(Rows.Count, "a").End(xlUp).Row
    Lin = 2
    For R = 2 To ultimalinha
        If Plan1.Cells(R, 5) <> "" Then
        Plan10.Cells(Lin, 1) = Plan1.Cells(R, 1)
        Plan10.Cells(Lin, 6) = Plan1.Cells(R, 6)
        Plan10.Cells(Lin, 7) = Plan1.Cells(R, 7)
        Plan10.Cells(Lin, 8) = Plan1.Cells(R, 8)
        Plan10.Cells(Lin, 9) = Plan1.Cells(R, 9)
        Plan10.Cells(Lin, 10) = Plan1.Cells(R, 10)
        Plan10.Cells(Lin, 11) = Plan1.Cells(R, 11)
        Plan10.Cells(Lin, 12) = Plan1.Cells(R, 12)
        Plan10.Cells(Lin, 13) = Plan1.Cells(R, 13)
        Plan10.Cells(Lin, 14) = Plan1.Cells(R, 14)
        Plan10.Cells(Lin, 16) = Plan1.Cells(R, 16)
        Plan10.Cells(Lin, 17) = Plan1.Cells(R, 17)
        Plan10.Cells(Lin, 18) = Plan1.Cells(R, 18)
        Plan10.Cells(Lin, 19) = Plan1.Cells(R, 19)
        Plan10.Cells(Lin, 20) = Plan1.Cells(R, 20)
        Plan10.Cells(Lin, 21) = Plan1.Cells(R, 21)
        Plan10.Cells(Lin, 22) = Plan1.Cells(R, 22)
        Plan10.Cells(Lin, 23) = Plan1.Cells(R, 23)
        Plan10.Cells(Lin, 24) = Plan1.Cells(R, 24)
        Plan10.Cells(Lin, 25) = Plan1.Cells(R, 25)
        Plan10.Cells(Lin, 26) = Plan1.Cells(R, 26)
        Lin = Lin + 1
        
        End If
    Next
    
Application.ScreenUpdating = True

End Sub
 
Postado : 23/12/2015 10:30 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Veja se é isto o que quer :

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False

    If Application.Intersect(Target, Range("E2:E30000")) Is Nothing Then Exit Sub

    If Target.Value <> "R" Then
    
    Else
    
    Plan10.Range("A3:Z200").ClearContents 'comando que limpa as linhas da planilha espelho
    ultimalinha = Plan1.Cells(Rows.Count, "a").End(xlUp).Row
    
    Lin = 2
        
        For R = 2 To ultimalinha
            If Plan1.Cells(R, 5) <> "" Then
            Plan10.Cells(Lin, 1) = Plan1.Cells(R, 1)
            Plan10.Cells(Lin, 6) = Plan1.Cells(R, 6)
            Plan10.Cells(Lin, 7) = Plan1.Cells(R, 7)
            Plan10.Cells(Lin, 8) = Plan1.Cells(R, 8)
            Plan10.Cells(Lin, 9) = Plan1.Cells(R, 9)
            Plan10.Cells(Lin, 10) = Plan1.Cells(R, 10)
            Plan10.Cells(Lin, 11) = Plan1.Cells(R, 11)
            Plan10.Cells(Lin, 12) = Plan1.Cells(R, 12)
            Plan10.Cells(Lin, 13) = Plan1.Cells(R, 13)
            Plan10.Cells(Lin, 14) = Plan1.Cells(R, 14)
            Plan10.Cells(Lin, 16) = Plan1.Cells(R, 16)
            Plan10.Cells(Lin, 17) = Plan1.Cells(R, 17)
            Plan10.Cells(Lin, 18) = Plan1.Cells(R, 18)
            Plan10.Cells(Lin, 19) = Plan1.Cells(R, 19)
            Plan10.Cells(Lin, 20) = Plan1.Cells(R, 20)
            Plan10.Cells(Lin, 21) = Plan1.Cells(R, 21)
            Plan10.Cells(Lin, 22) = Plan1.Cells(R, 22)
            Plan10.Cells(Lin, 23) = Plan1.Cells(R, 23)
            Plan10.Cells(Lin, 24) = Plan1.Cells(R, 24)
            Plan10.Cells(Lin, 25) = Plan1.Cells(R, 25)
            Plan10.Cells(Lin, 26) = Plan1.Cells(R, 26)
            Lin = Lin + 1
            
            End If
        Next
        
    End If

    Application.ScreenUpdating = True

End Sub

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

 
Postado : 23/12/2015 10:45 am
(@denilsonsl)
Posts: 84
Trusted Member
Topic starter
 

Perfeito Mauro.

Muito obrigado.

 
Postado : 23/12/2015 10:57 am