Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Macro que exclui e ...
 
Notifications
Clear all

Macro que exclui e Cria Hiperlink

 
2024 - VBA & Macros
Post Recente por fazerbem 9 anos atrás
7 Posts
2 Usuários
0 Reactions
1,272 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ola, em enexo eu envio uma planilha Teste e nela explico a vcs de forma clara o que eu gostaria . Peço a gentileza de vcs para que meu projeto tenha fim, e agora falta somente isso.

Grato a todos .

Andre Luiz

 
Postado : 04/12/2015 8:48 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

A parte que seleciona a loja com duplo clique vc pode testar aqui

Cole na folha da planilha teste.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim loja As String
loja = ActiveCell
If loja = "" Then
Exit Sub
Else
If ActiveCell.Value = loja Then
Sheets(loja).Select
End If
End If
End Sub

Agora qto a reorganização das lojas sugiro que vc use tudo em uma unica coluna e classifique manualmente pq caso o usuario erre a digitação e vc tenha muitas lojas o mesmo vai acabar perdendo a localização do que foi digitado. Assim vc pode excluir as lojas com sua macro e colocar os dados conforme vc precisa apos todas as criações de lojas como vc precisa,

Vc usa varias celulas mescladas isso nao é bom no meio da planilha, celulas mescladas devem ser usadas somente em titulos.

Isso evita erros no momento do uso da planilha.

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 : 05/12/2015 12:19 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Obrigado mais esta vez, vou testar a tarde, porem quanto a reorganizar manualmente com receio de alguem fazer coisa errada, não tera problema , pois esta é interna pra meu uso apenas, mas teria ao menos como quando ao excluir a aba, ja faço aqui, tambem excluir a loja que esta ai dentro com o hiperlink ? Teria uma instrucao pra acrescentar aqui ?

Andre

 
Postado : 05/12/2015 7:48 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ola boa Tarde, fiz o teste aqui, e é exatamente isso que eu queria, aguardo entao somente a rotina pra por dentro de minha Macro quando for apagar a Aba, pra que apague tambem o nome da Loja em Aba Teste.

Grato

André

 
Postado : 05/12/2015 9:43 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Poste rotina que vc usa para excluir a aba assim a adaptação é mais simples.

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 : 05/12/2015 11:35 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

OK, a rotina que faz apagar a ABA esta no finalzinho.

Gostaria entao que antes de terminar a Macro, ou no inicio da mesma, fosse na ABA "RESUMO", procurasse a Loja entre os intervalos;

B8:C21 e D8:E21, o nome da Loja usa o mesmo nome da Aba que estará sendo apagada.

' Excluir_Planilha da Loja

Worksheets(nome).Delete

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("C5")
    
    Dim Dest    As Range


 Application.DisplayAlerts = False 'desabilite o alerta

Application.ScreenUpdating = 0                                      'Deixa a macro mais rápida (Desliga a tela de atualização)
        
        Range("C5").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("AA3:AG3").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
    


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

' Botao Enviar Pedido
     
    Range("AK3").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("AN5:AO5").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("AK5").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("AK7").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("AN6:AO6").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("AI8").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("AI9").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("AI10").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("AK8").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("AM8").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("AN8").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("AK9").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("AM9").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("AM10").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("C17").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("R16").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("R22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
    
    Sheets("PEDIDO GAUER").Select
    Range("F51").Select
    Application.CutCopyMode = False
    Sheets(nome).Select
    Range("P13").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("R10").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("R9").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("R12").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("R11").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("R14").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("R15").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("R20").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("P24").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("AI13:AO52").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("A11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    
    Sheets("Resumo").Select
    Range("AP7:AQ13").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F63:G69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=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
    
' Oculta Novamente a Planilha
Sheets("PEDIDO GAUER").Visible = False
    
   
   Sheets(nome).Select
   
   

      Application.ScreenUpdating = 1                                       'Deixa a macro mais rápida (Liga a tela de atualização)

   
 ' Excluir_Planilha da Loja

  Worksheets(nome).Delete
   
   
   
   
   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.DisplayAlerts = False
   
    
    
      
   
   
End Sub
 
Postado : 05/12/2015 6:49 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Poste rotina que vc usa para excluir a aba assim a adaptação é mais simples.

Coloquei esta rotina ao final da minha macro, e assim funciona tudo certinho, quero apenas ir antes de fechar a Macro, ir na Aba "RESUMO" e apagar a Loja que esta la entre os intervalos de "B8:E21".

Esta Macro com esta linha de comando abaixo, é rodada na Aba que sera apagada, neste caso se refere a Dim ( nome ), pois ( nome ) esta relacionado a celula E5 , e E5 é o nome dado a ABA que será excluida.

' Excluir_Planilha da Loja

Worksheets(nome).Delete

Se ficar mais facil o entendimento abaixo esta uma das Macros desta Planilha, neste caso a especifica a este propósito.

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


 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
    


'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("Resumo").Select
    Range("AP7:AQ13").Select
    Selection.Copy
    Sheets("PEDIDO GAUER").Select
    Range("F63:G69").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=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 "atendimento-rj@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
    
' Oculta Novamente a Planilha
Sheets("PEDIDO GAUER").Visible = False
    
   
   Sheets(nome).Select
   
   
   
   
   
   
   
   
   
   

  
 ' Excluir_Planilha da Loja

  Worksheets(nome).Delete
   
   
   
   
   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 : 08/12/2015 3:53 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico