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,256 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 0
New 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: 0
New 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.

 
Postado : 05/12/2015 12:19 am
 fazerbem
(@fazerbem)
Posts: 0
New 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: 0
New 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: 0
New Member
 

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

 
Postado : 05/12/2015 11:35 am
 fazerbem
(@fazerbem)
Posts: 0
New 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: 0
New 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