Deleta conteudo de celula ao esxcluir ABA

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

Tenho na Plan1 de B8:B21 um espaço que é colado o nome das abas conforme as vou criando.
Por exemplo, se crio a Aba Loja 1, depois Loja 2, entao B8 = Loja 1 e B9 = Loja 2.

Agora preciso de uma outra Macro que quando eu excluir alguma Aba de loja que esta no intervalo de Plan1 B8:B21, ao clicar na ABA e excluir a loja, entao o nome da loja no intervalo B8:B21 da plan 1 é tb excluido.

Agradeço a todos.

Andre Luiz

Postado : 10/12/2015 3:20 pm

srobles

(@srobles)

Posts: 231

Estimable Member

Fala André, tudo bem?

Veja se é isso o que você procura.

Aguardo retorno.

Abs

Espero ter ajudado.

Abs.

Saulo Robles

Postado : 10/12/2015 5:49 pm

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

Ola meu amigao !! So tenho como ver amanha, ai testo e te falo.

Abracos

Postado : 10/12/2015 6:12 pm

srobles

(@srobles)

Posts: 231

Estimable Member

André,

Ok sem problemas!

Só para esclarecer :

Este modelo funciona da seguinte maneira : Uma aba é excluida e ao clicar no botão, o que ele faz é, varrer todas as abas e colocar seu devido nome no intervalo que você informou.Sei que é o oposto do que pediu, porém o resultado é o mesmo. :mrgreen:

Abs

Espero ter ajudado.

Abs.

Saulo Robles

Postado : 11/12/2015 8:11 am

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

Ola

Na Plan REsumo

entrar nos campos em azul

1- Entrar com nome de uma loja qualquer
2- nome quem fez o pedido
3- se foi por email, fone etc

4- Agora clique na macro que esta em H2 ( Criar Nova Solicitacao )

Vai ser criada uma nova ABA com o mesmo nome de ( RESUMO H10 ).

Note que ao ser criada a nova ABA, é criado no intervalo de B8:D21 em ( RESUMO ) a loja !

O que eu quero é que quando eu excluir a aba que tenha o mesmo nome em B8:B21, em RESUMO B8:D21, seja procurado o mesmo nome e apague a loja. Para isso use como referencia a Celula ( C5 ) da Aba que foi criada.

A ideia é antes de excluir a ABA ao eu rodar aqui a minha Macro que faz outras rotinas alem de excluir , tenha uma rotina no inicio que eu gostaria de fazer apagar a Loja de B8:D21, ai sim em seguida a ABA de mesmo nome continuara a executar outras coisas e por fim vai excluir a referida ABA.

Eu ja possuo a MACRO pronta e preciso somente adicionar esse detalhe.

segue anexo a planilha

Andre

Postado : 11/12/2015 9:54 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

E so vc digitar o nome da macro que exclui no ponto que vc deseja que seja excluida na macro que ja executa o que vc deseja.

exemplo

sub rotina()

sua rotina
excluir

end sub

sua macro vai rodar e vai excluir no momento que vc quiser

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 11/12/2015 10:02 am

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

Não entendi, o que quis dizer, baixe a minha olanilhe e vai entender, e so seguir o que escrevi acima, veja que la ja tem uma planilha de de uma loja , exclua a aba desta planilha e veja que em RESUMO B8 a loja fica la ainda eu quero que a mesma se apague ao excluir a aba de nome Loja do pAulo.

So vai entender se baixar

Andre

Postado : 11/12/2015 10:21 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

Planilha com senha de proteção nao da.

E sem a rotina que deve rodar antes, para fazer a adaptação... fica impossivel ajudar....

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 11/12/2015 1:55 pm

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

rsrssr, desculpe a senha e 1234, esqueci de por

Postado : 11/12/2015 2:04 pm

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

segue a senha e a rotina

senha - 1234

Sub A2_Gravar_Envio_Gauer()

'Botao Enviar Planilha que esta em Modelo Frete

'Salva a comissao

'Declaração de ariaveis
    Dim Ws1     As Worksheet
    Dim Ws2     As Worksheet
    Dim nome
    nome = Range("E5")
    
    Dim Dest    As Range

'Sheets("LANCAR COMISSAO").Visible = True
Sheets("PEDIDO G").Visible = True



 Application.DisplayAlerts = False 'desabilite o alerta

Application.ScreenUpdating = 0                                      'Deixa a macro mais rápida (Desliga a tela de atualização)
        
        Range("E5").Select
        
        
        Set Ws2 = Sheets("LANCAR COMISSAO")                             'Referencia a guia LANÇAR COMISSAO como Ws2
        
        Set Dest = Ws2.Range("B3").Range("B52").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

        Range("AJ3:AP3").Copy                                        'Copia o intervalo AB2:AG2 da guia Resumo
        
        Dest.PasteSpecial xlPasteValues                                  'Cola valores na guia Comissão
        Application.CutCopyMode = False                                  'Desativaj o clipboard


    Set Ws1 = Sheets(nome)
    'MsgBox Ws1.Name
    Ws1.Select
    

Run "Vezes_Ja_Enviadas_Gauer"


'Salva numero de Recibo na pasta /Recibos

Dim pdf As String
pdf = "C:UsersAndreDesktopPedidos GauerRecibos" & "Recibo " & ActiveSheet.Range("S5").Value & " - " & ActiveSheet.Range("E5").Value & ".pdf"
'O original é este aqui : pdf = ThisWorkbook.Path & "Recibo " & ActiveSheet.Range("S5").Value & " - " & ActiveSheet.Range("E5").Value & ".pdf"
ActiveSheet.Range("H4:T57").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdf


' Reexibe Planilha Oculta
Sheets("PEDIDO GAUER").Visible = True
 

' Botao Enviar Pedido
     
    Range("AD3").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C2:G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AG5:AH5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F4:G4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AD5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AD7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C6:G6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AG6:AH6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AB8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AB9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(nome).Select
    Range("AB10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets(nome).Select
    Range("AD8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AF8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Sheets(nome).Select
    Range("AG8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    Sheets(nome).Select
    Range("S5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    
    Sheets(nome).Select
    Range("AF8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AD9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AF9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("AF10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("E9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("E17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G57").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("T16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("D9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(nome).Select
    Range("T22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     Sheets(nome).Select
    Range("R13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F51").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(nome).Select
    Range("T10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G52").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets(nome).Select
    Range("T9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G53").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
    Sheets(nome).Select
    Range("T12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G54").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(nome).Select
    Range("T11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F55").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(nome).Select
    Range("T14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F56").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            
    Sheets(nome).Select
    Range("T15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G56").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            
    Sheets(nome).Select
    Range("T20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G58").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
   Sheets(nome).Select
    Range("R24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G59").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         
        
        
   Sheets(nome).Select
    Range("AB13:AH52").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
     Sheets(nome).Select
    Range("E30:E32").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A52:A54").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets(nome).Select
    Range("G30:G32").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C52:C54").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets(nome).Select
    Range("S11").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("G55").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("D9").Select
    Selection.Copy
    Range("D57").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
        
    
 'Rotina enviar por Email

 'Define a Planilha que será enviada por Email. Ex: Plan1, Plan2, Pedidos, etc
 sPlanAEnviar = "PEDIDO GAUER"
 
'Cria um novo arquivo Excel
 Set NovoArquivoXLS = Application.Workbooks.Add
 
 'Copia a Planilha para o novo arquivo criado
 ThisWorkbook.Sheets(sPlanAEnviar).Copy Before:=NovoArquivoXLS.Sheets(1)
 
'Salva o Arquivo
 NovoArquivoXLS.SaveAs ThisWorkbook.Path & "" & sPlanAEnviar & ".xLs"
sExcluirAnexoTemporario = NovoArquivoXLS.FullName

'Envia o email a Gauer
NovoArquivoXLS.SendMail "gauer@gauerdobrasil.com.br", "Pedido " & [F4].Value, True

'Fecha o Arquivo Novo
NovoArquivoXLS.Close

'Exclui o arquivo criado apenas para ser enviado
Kill sExcluirAnexoTemporario


'DEixa a planilha pronta para o proximo envio

    Range("C2:G2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("C4:E4").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F4:G4").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F5:G5").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C6:G6").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A7:B7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C7:D7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F7:G7").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E8:G8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8:D8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A8:B8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A9:B9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E9:G9").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F51").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G52").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G53").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G54").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G55").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G56").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G57").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G58").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G59").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A52").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A53").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A54").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C52").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C53").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C54").Select
    ActiveCell.FormulaR1C1 = ""
    Range("F4:G4").Select
    
    Range("A11:G50").Select
    Selection.ClearContents
    Range("D57").Select
    Selection.ClearContents
    
' Oculta Novamente a Planilha
Sheets("PEDIDO GAUER").Visible = False
'Sheets("LANCAR COMISSAO").Visible = False
Sheets("PEDIDO G").Visible = False
    
   Sheets(nome).Select
   
 ' Excluir_Planilha da Loja

  Worksheets(nome).Delete
   
   Sheets("Resumo").Select
   
   
   On Error Resume Next
   Dim Caminho2 As String 'declaracao da variável caminho
   'Caminho = ThisWorkbook.Path & ""
   Caminho = "C:UsersAndreDesktopPedidos Gauer" & ""
   ActiveWorkbook.SaveAs Filename:=Caminho & [C32].Value & ".xlsm"
   'MsgBox ("Planilha Salva Como : ") & [C32].Value & ".xlsm"
   
      Application.ScreenUpdating = 1                                       'Deixa a macro mais rápida (Liga a tela de atualização)
   
   
   
Application.DisplayAlerts = False
   
    

End Sub

Postado : 11/12/2015 2:06 pm

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

BINGO !!!!!!!!!!!

Nao é que eu consegui fazer usando o gravador de MACRO !!!!

Sub Macro1()
'
' Macro1 Macro
'
Dim nome
nome = Range("C5")

Sheets("RESUMO").Select

Cells.Find(What:=nome, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate

Selection.ClearContents

End Sub

OBRIGADO a todos .

Andre

Postado : 11/12/2015 2:13 pm

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

A macro nao roda pq o arquivo esta incompleto.

A partir de qdo a planilha deve ser excluida?

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 11/12/2015 2:32 pm

fazerbem

(@fazerbem)

Posts: 697

Honorable Member

Topic starter

Ola Prudencio, coloquei a rotina acima dentro de minha macro e rodou chupeta, esta conforme eu queria agora.

usei a rotina abaixo, o importante que mesmo sem sacar nada de macro, pesquisa aqui e acola, vem no forum, troca ideia, e assim vai, acabei pegando uma ideia aqui neste video abaixo, dai adaptei a Dim nome e PIMBA !!!

https://www.youtube.com/watch?v=8VWNcR8x4hk

ficou assim entao :

'Apagar a Loja em RESUMO ( B8:D21 )

Sheets("RESUMO").Select
Cells.Find(What:=nome, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.ClearContents

Postado : 11/12/2015 2:38 pm