Este fórum está sendo desativado

[fazerbem]

Gostaria de agradecer pelo Post anterior, mas achei necess;ario o reabrir, devido ja ter quebrado aqui a cabeça e nao conseguir aplicar em minha planilha.

Gostei das 2 formas apresentadas, tanto por formula quanto por Vba. Mas nao sei se por Vba daria pra fazer , se desse talvez seria até menos complicado, pois quando eu crio uma nova Venda , cria-se uma nova Aba e esta é dado o nome de uma determinada loja conforme esteja associada a uma Celula. Por isso criei uma Dim nome. A aba é criada com nome de Plan 1, 2, 3 e trocado imediatamente pela Din que ta na Celula determinada.

Entao sobrou apenas o modo Nao Vba. Mas nao to conseguindo fazer, e queria poder entender como fazer, ao inves de postara minha planilha, pois quero aprender e assim aplicar em outra tabela.

Por isso gostaria que me ensinassem um passo a passo,

Post Anterior : http://gurudoexcel.com/forum/viewtopic.php?f=14&t=546

Abaixo segue meu Codigo quando uma nova Aba é criada, queria por ai dentro o Codigo Vba se possivel, e ss imagens que usarei sao uma Imagem de Frete, outra de Envio e outra de autorizacao. Para que apareça vai depender do resultado desta formula:

Essa formula esta em G25 =SE(E23=0,"Frete",SE(E23="Aguardando Cliente !","Aguarde",SE(E(E23=1,OU(E15="E-Sedex",E15="PAC",E15="Transportadora")),"Enviar","")))

Segue tb em anexo parte da minha planilha que é gerada rodando a macro abaixo.

Código: Selecionar todos

Sub A1_Criar_Planilha_Pedido_Frete()

 Application.DisplayAlerts = False 'desabilite o alerta
   

Dim Wp1 As Worksheet
Dim Wp2 As Worksheet
Dim Wp3 As Worksheet

Dim Valor_a_colar As String
Dim Dest As Range
Set Wp1 = Sheets("RESUMO") 'Referencia a guia Resumo como Ws1
Set Wp3 = Sheets("MODELO FRETE") '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("E5")
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
        

' Reexibe Planilha Oculta
Sheets("MODELO FRETE").Visible = True
        
        
Worksheets("MODELO FRETE").Unprotect "861485"
      
        
    Sheets("MODELO FRETE").Select
    
    Run "Gerar_Recibo"
    
    Cells.Select
    Selection.Copy
    Sheets(nome).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("B4").Select
    Rows("1:1").RowHeight = 8.25
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
   
    Sheets("MODELO FRETE").Select
    ActiveSheet.Shapes.Range(Array("Picture 6")).Select
    Selection.Copy
    Sheets(nome).Select
    Range("B7").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 29.25
    Selection.ShapeRange.IncrementTop -6.75
    Selection.OnAction = "B01_Frete_Gauer_Dentro_Nova_Planilha"
    Sheets("MODELO FRETE").Select
    ActiveSheet.Shapes.Range(Array("Picture 8")).Select
    Selection.Copy
    Sheets(nome).Select
    Range("B13").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 27.75
    Selection.ShapeRange.IncrementTop -9
    Selection.OnAction = "B1_Enviar_Frete_Lojista"
    Sheets("MODELO FRETE").Select
    ActiveSheet.Shapes.Range(Array("Picture 12")).Select
    Selection.Copy
    Sheets(nome).Select
    Range("B21").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 8.25
    Selection.ShapeRange.IncrementTop -23.25
    Selection.OnAction = "A2_Gravar_Envio_Gauer"
    Range("B2:B3").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "RESUMO!A1", TextToDisplay:="Menu Principal"
    Selection.Font.Underline = xlUnderlineStyleNone
    Selection.Font.Bold = True
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Selection.Font.Italic = True
    Sheets("MODELO FRETE").Select
    ActiveSheet.Shapes.Range(Array("Imagem 10")).Select
    Selection.Copy
    Sheets(nome).Select
    Range("AB3:AB6").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 11.25
    Selection.ShapeRange.IncrementTop -6.75
    Selection.ShapeRange.IncrementTop -3


'Aqui copiar dados ABA RESUMO P/ Nova Pasta

    Sheets("RESUMO").Select
    Range("H10:J11").Select
    Selection.Copy
    Sheets(nome).Select
    Range("E5:G6").Select
    ActiveSheet.Paste
    Sheets("RESUMO").Select
    Range("H14:J17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("E7:G10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("H20:J21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("E11:G12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("H22:J23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("E13:G14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("H24:J25").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("E15:G16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("N3:T4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("I5:O6").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("I7:O7").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("I8:K8").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("I9:L9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("N8:P8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("I10:K10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("N9:P9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("I11:K11").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("L8:O8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("R7:T8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("M9:O9").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("L10").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("L11:O11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("O10:T11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("J12:O13").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("I15:K15").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("L15").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("M15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("S13:T52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("N15:O15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("Q53:R54").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("N55:O56").Select
    Sheets("RESUMO").Select
    Range("S53:T54").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("N55:O56").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("R9:S9").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("R11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("X9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("S11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("W10:X13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("R12:S12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("W18:X21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("R20:S21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copia Pedido G P/ Nova Pasta

    Sheets("PEDIDO G").Select
    Range("C3:G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    ActiveWindow.SmallScroll ToRight:=14
    Range("AD3:AH3").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("AD5:AF5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("F5:G6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AG5:AH5").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("AD7:AH7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("A8:B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AB8:AC8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("C8:D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AD8:AE8").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("AF8").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("AG8:AH8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("E9:G10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AF9:AH9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PEDIDO G").Select
    Range("A12:G51").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("AB13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("PEDIDO G").Select
    Range("F52").Select
    Selection.Copy
    Sheets(nome).Select
    Range("AG53").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


' Copia ABA RESUMO para Nova Planilha

    Worksheets("RESUMO").Unprotect "861485"

    Sheets("RESUMO").Select
    Range("AM1:AN1").Select
    Selection.EntireColumn.Hidden = False
    Range("Y1:AO1").Select
    Selection.EntireColumn.Hidden = False
    Range("AB2:AH2").Select
    Selection.Copy
    Sheets(nome).Select
    Range("AK3").Select
    Sheets("RESUMO").Select
    Range("AC2:AH2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AO3").Select
    
 Sheets("RESUMO").Select
     Range("Z8:AL8").Select
    Selection.EntireColumn.Hidden = True
   
    
    Worksheets("RESUMO").Protect "861485"
    
    
    Sheets("PEDIDO G").Select
    Range("A53:A55").Select
    Selection.Copy
    Sheets(nome).Select
    Range("AR21:AR27").Select
    Range("AR27").Activate
    Range("E30").Select
    Application.CutCopyMode = False
    ActiveSheet.Unprotect
    Sheets("PEDIDO G").Select
    Selection.Copy
    Sheets(nome).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("G30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    
        Sheets("PEDIDO G").Select
    Range("G60").Select
    Selection.Copy
    Sheets(nome).Select
    Range("R24").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Selection.Font
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
    End With
    Range("E5:G6").Select
    
    ActiveWindow.SmallScroll ToRight:=-14
    Range("E5:G6").Select
    
    Sheets("RESUMO").Select
    Range("AM2:AM6").Select
    Selection.Copy
    Sheets(nome).Select
    Range("Q37:Q41").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q37:S41").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("Q49").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("E5:G6").Select

    'Sheets(nome).Select
    Worksheets(nome).Protect "861485"
 
 
 Sheets("Resumo").Select
 
 On Error Resume Next
Dim Caminho2 As String 'declaracao da variável caminho
'Caminho = ThisWorkbook.Path & "\"
Caminho = "C:\Users\Andre\Desktop\Pedidos 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 !")
   MsgBox "Sistema Pronto!", vbExclamation, "Atenção:"


Worksheets("MODELO FRETE").Protect "861485"

' Oculta Novamente a Planilha
Sheets("MODELO FRETE").Visible = False

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

End Sub

Andre

[fazerbem]

Ola, vi que 2 pessoas ja baixaram o anexo, estou torcendo para em breve ter a solucao .

Desde ja agardeço.

Andre