Temporizador Termino execucao da macro

fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
Pode parecer uma besteira minha, mas as algumas de minhas macros estao demorando até quase 30s para fazer todo o trabalho, por serem muito grnades, entao como tenho varios pedidos a tirar, precisaria que assim que eu executasse tais macros, ficasse tipo um relogio sendo mostrado quantos segundos até o Ok para eu poder tirar outro pedido, e se possivel com um Bip após chegar ao zero.
Grato amigos
Andre
Postado : 04/12/2015 12:25 pm
EDIVAN
(@edivan)
Posts: 119
Estimable Member
Olha não sei se é possível mas com certeza deve ser....
Por que você não usa uma mensagem de aviso no final da macro?
Dessa forma quando terminar vai aparecer a mensagem que já acabou...
Visite meu blog:
programacaopassoapasso.wordpress.com
Postado : 04/12/2015 2:20 pm
fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
Tens Razao, nao havia pensado nisso, fiz aqui ficou a contento, mas se pudesse colocar um alarmezinho ia ficar SHOW tambem.
É que meu codigo ficou muito grande , fiz com o gravador de macro e associando as dicas dos amigos aqui, veja como ficou grande rsrsrs. Mas o importante é que ta tudo funcionando. leva cerca de 18s.
Sub A1_Criar_Planilha_Pedido_Frete()

 Application.DisplayAlerts = False 'desabilite o alerta
   

Dim Wp1 As Worksheet
Dim Wp2 As Worksheet
Dim Valor_a_colar As String
Dim Dest As Range
Set Wp1 = Sheets("RESUMO") 'Referencia a guia Resumo como Ws1

'Definir destino
Dim cell As Range
For Each cell In Range("B8:B21")
    cell.Select
    If cell = "" Then
        Set Dest = cell
        GoTo Final
    End If
Next cell
For Each cell In Range("D8:D21")
    If cell = "" Then
        Set Dest = cell
        GoTo Final
    End If
Next cell

Final:

Valor_a_colar = Range("H10")  'Copia o intervalo C4 da guia Resumo
Dest = Valor_a_colar 'Cola valores na guia Comissão
Application.CutCopyMode = False

Dim Ws1     As Worksheet
Dim nome
nome = Range("C5")
Set Ws1 = Sheets("RESUMO")

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

Sheets.Add ' inseri uma nova planilha
nome = Sheets("RESUMO").Range("H10")
ActiveSheet.Name = nome ' renomeia a planilha
Sheets("RESUMO").Select
        
    Sheets("MODELO FRETE").Select
    Range("A1:w80").Select
    Selection.Copy
    Sheets(nome).Select
    Rows("1:1").RowHeight = 14.25
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("1:1").RowHeight = 11.25
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

'copiar o novo botao que ainda vou criar aqui


    Sheets("MODELO FRETE").Select
    
    ActiveSheet.Shapes.Range(Array("Picture 3")).Select
    Selection.Copy
    Sheets(nome).Select
    Range("Q2:Q3").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft -2.25
    Selection.ShapeRange.IncrementTop 18
    Rows("2:2").RowHeight = 15.75
    Rows("3:3").RowHeight = 15.75
    Selection.ShapeRange.IncrementLeft -1.5
    Selection.ShapeRange.IncrementTop -9
    Selection.ShapeRange.IncrementLeft 3.75
    Selection.ShapeRange.IncrementTop 0.75
    
    Sheets("PEDIDO G").Select
    Range("A53:A55").Select
    Selection.Copy
    Sheets(nome).Select
    Range("C30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C53:C55").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("E30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("MODELO FRETE").Select
    Range("AA2:AG3").Select
    Selection.Copy
    Sheets(nome).Select
    Range("AA2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

    Sheets("RESUMO").Select
    Range("AC2:AH2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AB3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("MODELO FRETE").Select
    Range("C23:E23").Select
    Selection.Copy
    Sheets(nome).Select
    Range("C23:E23").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("MODELO FRETE").Select
    Range("C25:C27").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("C25:C27").Select
    ActiveSheet.Paste

    Sheets("MODELO FRETE").Select

    Range("X2:Y3").Select
    Selection.Copy
    Sheets(nome).Select
    Range("X2").Select
    ActiveSheet.Paste
    Sheets("MODELO FRETE").Select
    Range("Y2:Y3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("Y2").Select
    
    Sheets("MODELO FRETE").Select
    
    Range("X2:X3").Select
    Selection.Copy
    Sheets(nome).Select
    Range("X2").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Sheets("MODELO FRETE").Select
    Range("Y2:Y3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
        
    Range("Y2").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Sheets("MODELO FRETE").Select
    Range("X1:Y1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("X1").Select
    ActiveSheet.Paste
    Range("X2:Y3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X16").Select
    ActiveSheet.Paste
    Range("X22").Select
    ActiveSheet.Paste

    Range("X41").Select
    ActiveSheet.Paste
    Range("X52").Select
    ActiveSheet.Paste
        Sheets("MODELO FRETE").Select
    Range("X4:Y15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("X4").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("MODELO FRETE").Select
    Range("X18:Y21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("X18").Select
        
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("MODELO FRETE").Select
    Range("X24:Y40").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("X24").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    
    Sheets("MODELO FRETE").Select
        Range("X43:Y51").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("X43").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("MODELO FRETE").Select
    Range("X54:Y62").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("X54").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("X2:Y62").Select
    Range("X62").Activate
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
        Range("X63:Y80").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With


     Sheets("RESUMO").Select
     Range("H10:J10").Select
     Selection.Copy
 
     Sheets(nome).Select
     Range("C5").Select
'ActiveSheet.Paste

'cola na pasta largura criada (1)a largura coluna e (2)os dados
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False '(1)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False  '(2)

Application.CutCopyMode = False                                  'Desativaj o clipboard

Sheets("RESUMO").Select
Range("H14:J14").Select
Selection.Copy
    Sheets(nome).Select
    Range("C7:E10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C7:E10").Select

Application.CutCopyMode = False                                  'Desativaj o clipboard

Sheets("RESUMO").Select
Range("H20:J25").Select
Selection.Copy
    Sheets(nome).Select
    Range("C11:E16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C11:E16").Select

Application.CutCopyMode = False                                  'Desativaj o clipboard

Sheets("MODELO FRETE").Select
         Range("A1:R56").Select
    Selection.Copy
    Sheets(nome).Select
    Rows("1:1").RowHeight = 14.25
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Rows("1:1").RowHeight = 11.25
    
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Sheets("RESUMO").Select
    Range("N3:T4").Select
    Selection.Copy
    Sheets(nome).Select
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("RESUMO").Select
    Range("N5:T5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("G7:M7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                
    Sheets("RESUMO").Select
    Range("N6:P6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("G8:I8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("RESUMO").Select
    Range("Q6:T6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("J8:M8").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("N7:Q7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("G9:J9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("R7:T7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("K9:M9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("N8:P9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("G10:I10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("Q8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("J10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("R8:T8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("K10:M10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("Q9:T9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("J11:M11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
    Sheets("RESUMO").Select
    Range("O10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("H12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("RESUMO").Select
    Range("N13:P52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("G15:I15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("RESUMO").Select
    Range("Q13:Q52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("J15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
        
        Range("R13:R52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("K15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("RESUMO").Select
        Range("S13:T52").Select
    Selection.Copy
    Sheets(nome).Select
        Range("L15:M15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("S53:T54").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
        Range("L55:M56").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("RESUMO").Select
    
    Range("W7:X8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("P9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("RESUMO").Select
    Range("W9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("P11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("P:P").ColumnWidth = 5.29
    Columns("P:P").ColumnWidth = 4.29
    Sheets("RESUMO").Select
    Range("X9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("Q11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Q:Q").ColumnWidth = 10.57
    Sheets("RESUMO").Select
    Range("W10:X13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("P12:Q12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("MODELO FRETE").Select
    Range("C15").Select
    Selection.Copy
    Range("P16:Q17").Select
    ActiveSheet.Paste Link:=True
    Application.CutCopyMode = False
    ActiveSheet.Unprotect
    Range("C15:E16").Select
    Selection.Copy
    Range("P16:Q17").Select
    ActiveSheet.Paste Link:=True
    Range("C17:E18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("P18:Q19").Select
    ActiveSheet.Paste Link:=True
    Application.CutCopyMode = False

    Sheets(nome).Select

'Formulas Frete e Envio

    Range("P16:Q17").Select
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-13]="""","""",R[-1]C[-13])"
    Range("P18:Q19").Select
    ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-13]="""","""",R[-1]C[-13])"
    Range("P20:Q21").Select
        
    Range("C11").Select
    Selection.Copy
    Range("C21:E22").Select
    ActiveSheet.Paste Link:=True

    Sheets("MODELO FRETE").Select
    Application.CutCopyMode = False
    Range("P16:Q17").Select
    Selection.Copy
    Range("R16").Select
    ActiveSheet.Paste Link:=True
    Range("P18:Q19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R18").Select
    ActiveSheet.Paste Link:=True
    Range("S20").Select
    Application.CutCopyMode = False

    Sheets("RESUMO").Select
    Range("W18:X19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("P20:Q21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("W20:X21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("P22:Q23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("P22:Q23").Select
    Selection.FormatConditions.Delete
            
    Application.CutCopyMode = False
    
    Sheets("Pedido G").Select
        Range("G60").Select
    Selection.Copy
    Sheets(nome).Select
    Range("P24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Font
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
    End With
        
 Sheets("RESUMO").Select
 
 Sheets("MODELO FRETE").Select
    Range("AI1:AP53").Select
    Selection.Copy
    Sheets(nome).Select
    Range("AI1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Range("Z1:AH1").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("Z2:Z12").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AA12:AH12").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AA4:AH12").Select
    Range("AA12").Activate
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("AH2:AH3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Sheets("MODELO FRETE").Select
    
    ActiveSheet.Shapes.Range(Array("Bevel 2")).Select
    
    Selection.Copy
    Sheets(nome).Select
    Range("D25").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 8.25
    Selection.ShapeRange.IncrementTop 4.5
    Range("P16:Q17").Select
    Columns("Q:Q").ColumnWidth = 11.86
    Range("C5:E6").Select

     Sheets("PEDIDO G").Select
    Range("C3:G3").Select
    Selection.Copy
    Sheets(nome).Select
    Range("AK3:AO3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C5:E5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AK5:AM5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F5:G5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AN5:AO5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F6:G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AN6:AO6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C7:G7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AK7:AO7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("A8:B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AI8:AJ8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("A9:B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AI9:AJ9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C8:D8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AK8:AL8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C9:D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AK9:AL9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AM8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F8:G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AN8:AO8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E9:G9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AM9:AO9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E10:G10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AM10:AO10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

' Aqui copia itens Pedido G para nome

    Sheets("PEDIDO G").Select
    Range("A12:G51").Select
    Selection.Copy
    
    Sheets(nome).Select
    Range("AI13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("P9:Q9").Select
    Selection.Copy
    Range("R9").Select
    ActiveSheet.Paste Link:=True
    Range("P10:Q10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R10").Select
    ActiveSheet.Paste Link:=True
    Range("P11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R11").Select
    ActiveSheet.Paste Link:=True
    Range("Q11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("S11").Select
    ActiveSheet.Paste Link:=True
    Range("P12:Q12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R12").Select
    ActiveSheet.Paste Link:=True
    Range("P13:Q13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R13").Select
    ActiveSheet.Paste Link:=True
    Range("P14:Q14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R14").Select
    ActiveSheet.Paste Link:=True
    Range("P15:Q15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R15").Select
    ActiveSheet.Paste Link:=True
    Range("P16:Q17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R16").Select
    ActiveSheet.Paste Link:=True
    Range("P18:Q19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R18").Select
    ActiveSheet.Paste Link:=True
    Range("P20:Q21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R20").Select
    ActiveSheet.Paste Link:=True
    Range("P22:Q23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("R22").Select
    ActiveSheet.Paste Link:=True
    
  Range("Y2:Y3").Select
    Selection.EntireColumn.Hidden = True
    
    ActiveSheet.Shapes.Range(Array("Bevel 3")).Select
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.ShapeRange.IncrementTop -4.5
     
    Application.CutCopyMode = False
    Range("C5").Select
    
   Application.ScreenUpdating = 1                                       'Deixa a macro mais rápida (Liga a tela de atualização)

    'Sheets(nome).Select
 
 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"
        
        
Run "D1_Limpar"

Range("H24").Select
ActiveCell = "Frete Solicitado"
Range("H28").Select
ActiveCell = "=H22"
Range("H30").Select
ActiveCell = "=H20"

Range("H2").Select

   Application.DisplayAlerts = True 'habilite novamente
   
   MsgBox (" Sistema Pronto !")

End Sub
Grato
Andre
Postado : 04/12/2015 2:41 pm
EDIVAN
(@edivan)
Posts: 119
Estimable Member
Quanto ao alarme eu nao sei muito bem, mas a própria MSGBOX tem alarmes se você coloca-la como exclamation, ou error eu acho que tem um som sim...
Postado : 04/12/2015 3:10 pm
MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
Como vc nao disse como deseja esse alarme...
Tente assim
MsgBox "Sistema Pronto!", vbExclamation, "Atenção:"
Substitua essa pela sua e teste.
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 : 04/12/2015 3:29 pm