Guru do Excel e Power BI

Novamente venho pedir ajuda a vcs, e ao AlexandreVba

Tenho esta Macro abaixo porem queria implantar mais um recurso , que seria antes de Gravar a Nova Planilha conforme celula H10, ir para uma outra planilha chamada "PEDIDO" e ativar a Celula desta em A1. Desta forma entao sera gravada a Planilha X= conforme Celula A1 e depois, conforme consta na macro abaixo, a planilha Base será salva tambem. Entao ao abrir a planilha que foi salva o pedido ( Celula H10 ) , a mesma sera aberta na Planilha de nome "Pedido" e ao abrir a planilha Base a mesma esta sendo ja aberta na planilha Resumo . ( isso aqui esta ocorrendo). Entao preciso resolver so o caso da Planilha salva no nome contido em H10.

Esta é a Macro que esta perfeita:

Sub Salvar_Pedido()

'Declaração de ariaveis
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet

Dim Dest As Range

Application.ScreenUpdating = 0 'Deixa a macro mais rápida (Desliga a tela de atualização)
Set Ws1 = Sheets("RESUMO") 'Referencia a guia Resumo como Ws1
Set Ws2 = Sheets("LANCAR COMISSAO") 'Referencia a guia LANÇAR COMISSAO como Ws2
Set Ws3 = Sheets("PRODUTOS")
Set Dest = Ws2.Range("B3").Range("B52").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Ws1.Range("AB2:AH2").Copy 'Copia o intervalo AB2:AG2 da guia Resumo
Dest.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Application.CutCopyMode = False 'Desativaj o clipboard


On Error Resume Next
Dim Caminho As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [H10].Value & ".xlsm"
'MsgBox ("Planilha Salva Como : ") & [H10].Value & ".xlsm"


Ws1.Range("H10:J11,H20:H21,H26:H31").Value = "" 'Limpa as células
Ws3.Range("F4:F15,F18:F21,F24:F42,F45:F53,F56:F64").Value = ""
Sheets("PRODUTOS").Select
Range("F4").Activate
Sheets("RESUMO").Select
Range("H10:J11").Select
Application.ScreenUpdating = 1 'Deixa a macro mais rápida (Liga a tela de atualização)


Com essa modificacao abaixo da zebra, pois ao executar , nao é processado a gravacao da nova planilha com nome em H10 , somente e gravada a Palnilha Base



Grato

Andre

Leia-se:

Tenho esta Macro abaixo porem queria implantar mais um recurso , que seria antes de Gravar a Nova Planilha conforme celula H10, ir para uma outra planilha chamada "PEDIDO" e ativar a Celula desta em A1. Desta forma entao sera gravada a Planilha X= conforme Celula ( A10 ) e depois.....


Acima eu tambem disse a modificacao abaixo, mas nao coloquei entao segue a modificacao que nao estaria gravando a Palnilha do da Celula H10 e nem antes de gravar deixando a Planilha Pedido em destaque quando se abre novamente

Sub Salvar_Pedido()

'Declaração de ariaveis
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Ws4 As Worksheet ' comando adaptado

Dim Dest As Range

Application.ScreenUpdating = 0 'Deixa a macro mais rápida (Desliga a tela de atualização)
Set Ws1 = Sheets("RESUMO") 'Referencia a guia Resumo como Ws1
Set Ws2 = Sheets("LANCAR COMISSAO") 'Referencia a guia LANÇAR COMISSAO como Ws2
Set Ws3 = Sheets("PRODUTOS")
Set Ws4= Sheets("PEDIDO") ' COMANDO ADAPTADO
Set Dest = Ws2.Range("B3").Range("B52").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Ws1.Range("AB2:AH2").Copy 'Copia o intervalo AB2:AG2 da guia Resumo
Dest.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Sheets("PEDIDO").Select 'COMANDO ADAPTADO
Range("A1").Activate 'COMANDO ADAPTADO
Application.CutCopyMode = False 'Desativaj o clipboard


On Error Resume Next
Dim Caminho As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [H10].Value & ".xlsm"
'MsgBox ("Planilha Salva Como : ") & [H10].Value & ".xlsm"


Ws1.Range("H10:J11,H20:H21,H26:H31").Value = "" 'Limpa as células
Ws3.Range("F4:F15,F18:F21,F24:F42,F45:F53,F56:F64").Value = ""
Sheets("PRODUTOS").Select
Range("F4").Activate
Sheets("RESUMO").Select
Range("H10:J11").Select
Application.ScreenUpdating = 1 'Deixa a macro mais rápida (Liga a tela de atualização)


On Error Resume Next
Dim Caminho2 As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [C32].Value & ".xlsm"
'MsgBox ("Planilha Salva Como : ") & [C32].Value & ".xlsm"

End Sub

Favor ler as regras do fórum: http://gurudoexcel.com/forum/viewtopic.php?f=8&t=4

Regra nº 2:
Os membros devem postar de maneira que seja consistente com a "escrita normal". Os membros não devem usar quantidades excessivas de emoticons, não devem usar CAIXA ALTA EM EXCESSO, ou usar quantidades excessivas de pontuação, seja em posts ou títulos. Também não utilize textos como "AJUDA", "HELP", "DÚVIDA", "URGENTE" ou similares nos títulos. O título deve ser condizente com o conteúdo da sua pergunta.

Desculpe os transtornos, estou me adaptando.

Segue a solucao que encontrei e ficou ok.

Sub Salvar_Pedido()

'Declaração de ariaveis
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Ws4 As Worksheet

Dim Dest As Range

Application.ScreenUpdating = 0 'Deixa a macro mais rápida (Desliga a tela de atualização)
Set Ws1 = Sheets("RESUMO") 'Referencia a guia Resumo como Ws1
Set Ws2 = Sheets("LANCAR COMISSAO") 'Referencia a guia LANÇAR COMISSAO como Ws2
Set Ws3 = Sheets("PRODUTOS")
Set Dest = Ws2.Range("B3").Range("B52").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Ws1.Range("AB2:AH2").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 Ws4 = Sheets("PEDIDO")
Sheets("PEDIDO").Select
Range("A1").Select


On Error Resume Next
Dim Caminho As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [A1].Value & ".xlsm"
'MsgBox ("Planilha Salva Como : ") & [A1].Value & ".xlsm"


Ws1.Range("H10:J11,H20:H21,H26:H31").Value = "" 'Limpa as células
Ws3.Range("F4:F15,F18:F21,F24:F42,F45:F53,F56:F64").Value = ""
Sheets("PRODUTOS").Select
Range("F4").Activate
Sheets("RESUMO").Select
Range("H10:J11").Select
Application.ScreenUpdating = 1 'Deixa a macro mais rápida (Liga a tela de atualização)


On Error Resume Next
Dim Caminho2 As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [C32].Value & ".xlsm"
'MsgBox ("Planilha Salva Como : ") & [C32].Value & ".xlsm"

End Sub