Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Ajuda adaptar peque...
 
Notifications
Clear all

Ajuda adaptar pequeno código para executar em outra sheet

 
2024 - VBA & Macros
Post Recente por felipesalomao 12 anos atrás
4 Posts
2 Usuários
0 Reactions
1,045 Visualizações
RSS
 felipesalomao
(@felipesalomao)
Posts: 103
Estimable Member
Topic starter
 

Oi Pessoal, fiz um botão para apagar a linha que tiver selecionada na planilha atual automaticamente, funciona perfeitamente.

O que acontece agora é que tenho 3 sheets, são elas, cadastro, impostos e estimativas finais,
uma puxa dado da outra, logo tenho que apagar essa mesma linha nas outras duas sheets também (impostos e estimativas finais).
O problema que quando seleciono uma célula x na sheet cadastro, a célula que está marcada nas outras sheets não tem nada haver.

Segue código que consegui desenvolver até agora:

Sub ERASELINHA()
'Find the last used row in a Column: column A in this example
    Dim LastRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    With ActiveSheet
        
        ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Delete
        
    End With
    
    Application.EnableEvents = True
    
End Sub

Acredito que o caminho seja executar um código que após eu apertar o botão apagar linha em cadastro, ele vá até a planilha seguinte, marque a mesma célula que está selecionada em cadastro, execute o código que já tenho.

Só não sei fazer que na outra sheet fique ativo a célula que está ativa em "cadastro"

Entenderam ? Acredito que não seja muito complexo.

Abs !

 
Postado : 13/08/2012 3:31 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente assim:

Sub ERASELINHA_2()
Dim cAdr As Long, nSh As String
Application.ScreenUpdating = False
Application.EnableEvents = False
nSh = ActiveSheet.Name
 
cAdr = ActiveCell.Row
For Each sh In Sheets
    sh.Activate
    Rows(cAdr & ":" & cAdr).Select
    Selection.Delete Shift:=xlUp
Next
Sheets(nSh).Activate
Cells(cAdr, 1).Select
Application.EnableEvents = True
End Sub
 
Postado : 13/08/2012 5:46 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Pode testar esta tambem :

    Sub ERASELINHA_3()
        Dim Scel As Long
        Dim NextSh
        
        'Application.ScreenUpdating = False
        'Application.EnableEvents = False
       
        Scel = ActiveCell.Row 'Armazena o umero da Linha Atual Selecionada
       
        For Each sh In Sheets
            Set NextSh = sh
                NextSh.Cells(Scel, "A").EntireRow.Delete
        Next
        
        
        'Application.EnableEvents = True
       
    End Sub

[]s

 
Postado : 13/08/2012 6:14 pm
 felipesalomao
(@felipesalomao)
Posts: 103
Estimable Member
Topic starter
 

Experimente assim:

Sub ERASELINHA_2()
Dim cAdr As Long, nSh As String
Application.ScreenUpdating = False
Application.EnableEvents = False
nSh = ActiveSheet.Name
 
cAdr = ActiveCell.Row
For Each sh In Sheets
    sh.Activate
    Rows(cAdr & ":" & cAdr).Select
    Selection.Delete Shift:=xlUp
Next
Sheets(nSh).Activate
Cells(cAdr, 1).Select
Application.EnableEvents = True
End Sub

Muito Obrigado, aprendi algumas coisas analisando o código !! Contribuiu bastante !!

Pode testar esta tambem :

    Sub ERASELINHA_3()
        Dim Scel As Long
        Dim NextSh
        
        'Application.ScreenUpdating = False
        'Application.EnableEvents = False
       
        Scel = ActiveCell.Row 'Armazena o umero da Linha Atual Selecionada
       
        For Each sh In Sheets
            Set NextSh = sh
                NextSh.Cells(Scel, "A").EntireRow.Delete
        Next
        
        
        'Application.EnableEvents = True
       
    End Sub

[]s

Oi Mauro, muito obrigado mesmo pelo seu código, ficou excelente, por ser mais "simples, acabei entendendo melhor e consegui fazer exatamento o que eu queria. Meu código ficou assim:

Sub ERASELINHA2()
        Dim Scel As Long
        
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        Scel = ActiveCell.Row 'Armazena o umero da Linha Atual Selecionada
        
        Cells(Scel, "A").EntireRow.Delete
        Scel = Scel - 9
        
        
        Sheets("Impostos").Select
        Cells(Scel, "A").EntireRow.Delete
        Call Módulo3.ULTIMALINHA
                
        Sheets("Estimativas Finais").Select
        Cells(Scel, "A").EntireRow.Delete
        Call Módulo3.ULTIMALINHA
        
        Sheets("Order List").Select
        Cells(Scel, "A").EntireRow.Delete
        Call Módulo3.ULTIMALINHA
      
        Sheets("Cadastro").Select
        
        Application.EnableEvents = True
         
       
    End Sub

Abs

 
Postado : 13/08/2012 10:51 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico