Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Erro na Macro
 
Notifications
Clear all

Erro na Macro

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

Nesta rotina abaixo da Macro, eu preciso associar em ("Loja 1") uma DIM , como faço ?
Assim em .Body = corpo

Sub enviaPlanilhaAtiva_Gauer()

Dim oOutlook As Object
Dim oEmail As Object
Dim wbAtual As Workbook
Dim sNomeArquivo As String
Dim sLocalTemp As String
Application.ScreenUpdating = False

Dim corpo As String
corpo = Sheets("Loja 1").Range("AS20")

Sub enviaPlanilhaAtiva_Gauer()

Dim oOutlook As Object
Dim oEmail As Object
Dim wbAtual As Workbook
Dim sNomeArquivo As String
Dim sLocalTemp As String
Application.ScreenUpdating = False

Dim corpo As String
corpo = Sheets("Loja 1").Range("AS20")



Set oOutlook = CreateObject("Outlook.Application")
Set oEmail = oOutlook.CreateItem(0)
sLocalTemp = "C:UsersAndreDesktop"

' Copia a planilha ativa e salva em local temporário
ActiveSheet.Copy
Set wbAtual = ActiveWorkbook

' Aqui você define qual planilha deve ser gravada
sNomeArquivo = wbAtual.Worksheets("PEDIDO GAUER").name


On Error Resume Next
Kill sLocalTemp & sNomeArquivo
On Error GoTo 0
wbAtual.SaveAs Filename:=sLocalTemp & sNomeArquivo

With oEmail
    .To = "atendimento@fazerbem.com.br"
    .Subject = "Pedido " & [F4].Value
    .Body = corpo 
    .Attachments.Add wbAtual.FullName
    .Send

End With

'Deleta o arquivo temporário
wbAtual.ChangeFileAccess Mode:=xlReadOnly
Kill wbAtual.FullName
wbAtual.Close SaveChanges:=False

Set oEmail = Nothing
Set oOutlook = Nothing


End Sub
 
Postado : 14/12/2015 1:18 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Assim

Dim lj01 as string

lj01 = Loja 01

Basicamente assim.

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 : 14/12/2015 1:25 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

desculpe eu enrolei a pergunta.

quero colocar no corpo da mensagem uma determinada Celula que esta na ABA Loja 1, porem a ABA que será enviada é a ABA PEDIDO GAUER.

por isso que preciso de

.Body = corpo ' pois corpo é tudo aquilo que estiver em AS20 da plan em questao.

segue entao o codigo original que tenho aqui ao qual estaciona nesta linha

.Body = Sheets(nome).Range("AS20").Value ' nome é a String dada a todas as planilhas que sao criadas ao criar um novo pedido , pois nome = nome da nova aba Loja a, loja 2....)

Quando eu crio um novo pedido, eu possuo uma ABA padrao que servira de molde a todas as abas que forem criadas. Por isso na Macro de criacao de abas, eu pus :

Dim Ws1 As Worksheet
Dim nome
nome = Range("E5")

entao quando a nova ABA é criada eu copio tudo da ABA MODELO para Aba NOme , e ABA LOja 1 ou loja 2 .... = nome

aqui é onde esta o erro

Sub enviaPlanilhaAtiva_Gauer()

Dim oOutlook As Object
Dim oEmail As Object
Dim wbAtual As Workbook
Dim sNomeArquivo As String
Dim sLocalTemp As String

Application.ScreenUpdating = False
Set oOutlook = CreateObject("Outlook.Application")
Set oEmail = oOutlook.CreateItem(0)
sLocalTemp = "C:UsersAndreDesktop"

' Copia a planilha ativa e salva em local temporário
ActiveSheet.Copy
Set wbAtual = ActiveWorkbook

' Aqui você define qual planilha deve ser gravada
sNomeArquivo = wbAtual.Worksheets("PEDIDO GAUER").name


On Error Resume Next
Kill sLocalTemp & sNomeArquivo
On Error GoTo 0
wbAtual.SaveAs Filename:=sLocalTemp & sNomeArquivo

With oEmail
    .To = "gauer@gauerdobrasil.com.br"
    .Subject = "Pedido " & [F4].Value
    '.Body = "Isso e um teste"
    .Body = Sheets(nome).Range("AS20").Value
    .Attachments.Add wbAtual.FullName
    .Send

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


End With

'Deleta o arquivo temporário
wbAtual.ChangeFileAccess Mode:=xlReadOnly
Kill wbAtual.FullName
wbAtual.Close SaveChanges:=False

Set oEmail = Nothing
Set oOutlook = Nothing


End Sub

e abaixo minha aba de criacao para poder entender melhor.

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
        
Range("H10").Select
Selection.Copy
 
Range("AM10").Select
ActiveSheet.Paste
        
        

' Reexibe Planilha Oculta
Sheets("MODELO FRETE").Visible = True
Sheets("PEDIDO G").Visible = True
        
        
Worksheets("MODELO FRETE").Unprotect "861485"
      
        
    Sheets("MODELO FRETE").Select

    
' Faz aparecer as colulas ocultas
    
    Range("T9:AQ9").Select
    Selection.EntireColumn.Hidden = True
    Range("E5:G6").Select
    
    
'Gerar Recibo de vendas
    
    
    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 = "A3_Confirme_Envio"
    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("PEDIDO G").Select
    Range("E10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("B35").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("J13:O14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("N13:P56").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("I16:K16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("Q13:Q56").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("L16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("R13:R56").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("M16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("S13:T56").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("N16:O16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("RESUMO").Select
    Range("S57:T57").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("N60:O61").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("W20:X21").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(nome).Select
    Range("R22:S23").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: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 !")
   'MsgBox "Sistema Pronto!", vbExclamation, "Atenção:"


'Faz ocultar as colunas
    Range("U2:AP6").Select
    Range("U5").Activate
    Selection.EntireColumn.Hidden = False


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

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

Sheets(nome).Select


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

End Sub
 
Postado : 14/12/2015 1:49 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

E so trocar

lj01 = Loja 01

por

lj01 = range ("Celula").value

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 : 14/12/2015 2:23 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

E so trocar

lj01 = Loja 01

por

lj01 = range ("Celula").value

MPrudencio tu é ( FFFFFFFFFFFFFF )

Muito obrigado, e se nao for pedir muito me ajudaria neste :

viewtopic.php?f=10&t=18490

 
Postado : 14/12/2015 2:46 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico