Este fórum está sendo desativado

[fazerbem]

Ola, primeiramente quero agradecer ao AlexandreVBA pela ajuda prestada anteriormente. Muito bom este Site. Sou tambem Moderador de um forum chamado E-voo.com, na parte de Simuladores.
vamos a minha dúvida. Na postagem anterior, está a planilha ajeitada pelo AlexandreVba, e fiz confore anunciei uma alteracao e caiu certino no que eu queria, mas 99% pra isso veio do AlexandreVBa mesmo.

Eu quero que nesta mesma planilha, ser implantado um outro botao Macro.

Tenho a Celula H10 = Nome Fantasia da Loja ( exemplo loja: MV Anchieta )
Vou criar a celula A30 e A31, e nela irei escrever o endereço (diretório) ao qual quero que ao executar a Macro de Salvar Planilha, esta planilha seja salva em tal diretorio .
Para tanto o endereco a ser salvo vai depender do que vou expecificar na Celula A30 e A31
Vou explicar melhor:

Se na Celula A30 eu escrever C:\users\andre\desktop\pedidos\, e
Se na Celula A31 eu escrever Agosto

Entao ao executar a Macro, será gravada a Planilha MV Anchieta ( referencia celula H10 )
no diretorio da Celula A30 + A31

Isso quer dizer que a gravacao do nome , do diretorio sera feito conforme o que estiver nas Celulas H10, A30 e A31.

AlexandreVBa, se for possivel me passar a Macro , novamente lhe agradeço. A planilha vc ja tem basta postar aqui os comandos da Macro que ai eu crio .

[alexandrevba]

Boa tarde!!

Eu acho que eu não entendi, mas tente adaptar....

Não testado!!!

Código: Selecionar todos

Sub ComoUsarCelulaParaSalvarEmPasta()
     
    Dim FName           As String
    Dim FPath           As String
     
    FPath = "C:"
    FName = Sheets("RESUMO").Range("A30").Text
    ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
     
End Sub

Código: Selecionar todos

Sub ComoUsarCelulaParaSalvarEmPasta_II()
Dim wB As Workbook
Dim nPath As String
nPath = "C:\users\andre\desktop\pedidos\" & ThisWorkbook.Sheets("RESUMO").Range("A30").Value
Set wB = Workbooks.Add
With wB
    .SaveAs Filename:=nPath
End With
End Sub

Att

[fazerbem]

Vou explicar melhor AlexandreVBA,

Tive outra ideia melhor.

Tenho a Célula H6 = onde está o mês de referencia ( Agosto por exemplo )
Tenho a Celula H10 = igual ao nome fantasia da Loja ( Loja FazerBem, por exemplo )
Criei a Celula C32 e dentro dela entrei com o seguinte : C:\users\andre\desktop\pedidos\
Vou criar um botao mara executar a macro.

Gostaria ao executar esta macro, fosse gravado no diretorio que informei acima ( C:\users\andre\desktop\pedidos\ ) uma Planilha com o nome de Loja FazerBem ( nome este , ou outro nome que esteja na celula H10. O mesmo se vale pra tudo que estiver escrito nas celulas H6 e C32. A macro seguirá o parametro do que estiver escrito dentro dessas 3 celulas.

Entao executada a Macro, ao ir no explorer, la estaria o arquivo C:\users\andre\desktop\pedidos\Loja FazerBem.xLsm

Acho que agora expliquei certo.

Desta Forma continuo a ter aquela Macro que vc fez e uma macro separada com esta finalidade.

GRato mesmo mais uma vez.

Fico no agurado se puder de novo me ajudar.

Andre

[alexandrevba]

Boa tarde!!

faça um backup do arquivo original tente isso...

Código: Selecionar todos

Sub AleVBA_480()
    Dim SaveMeAs As String
    SaveMeAs = Sheets("RESUMO").Range("C32").Text
    Sheets("RESUMO").Copy
    ActiveSheet.Cells.Copy
    ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.SaveAs Filename:="C:\users\andre\desktop\pedidos\" & SaveMeAs
End Sub

Obs: Certifique se que as células do mês e nome fantasia estejam preenchidas e que seja nomes válido para arquivo.
https://support.microsoft.com/pt-br/kb/177506

Att

[fazerbem]

Salvar até salvou, mas acho que nao entendeu.Vamos la o que aconteceu.

EM C32 eu coloquei - C:\users\andre\desktop\pedidos\ entao inicialmente deu erro de execucao. Entao tirei da C32 o caminho e botei "AGOSTO". Dai entao salvou a planilha nno caminho que vc especificou na Macro. Porem salvou apenas a planilha REsumo e nao toda a Planilha. Eu queria toda a Planilha.

E quando salvou, a Planilha REsumo ficou aberta numa outra Planilha e sem outras planilhas na pasta.

Outra coisa eu quero especificar na Celula C32 qual caminho devera ser seguido, dai nao seria preciso colocar no comando da Macro em:
ActiveWorkbook.SaveAs Filename:="C:\users\andre\desktop\pedidos\" & SaveMeAs ficaria assim:
ActiveWorkbook.SaveAs Filename:="C32" & SaveMeAs
Pode ser feito ?

Outra coisa a Celula H6 e H10 tem que aparecer no comando.
H6 - Agosto 'mês de referencia que vou usar de acordo com o mês do ano
H10 - nome fantasia

Dai resumindo o que quero no comando:

Ao executar a Macro , Sera pego a Clelula H10 ( nome que sera gravada a planilha: Exemplo H10= FazerBem - entao sera gravada a planilha inteira Fazerbem.Xlsm.
Depois sera pego onde sera arquivada a planilha, neste caso dentro da C:\users\andre\desktop\pedidos\ = C21+H6


Outra coisa Porque vc colocou no comando abaixo a Celula A1?



Sub AleVBA_480()
Dim SaveMeAs As String
SaveMeAs = Sheets("RESUMO").Range("C32").Text
Sheets("RESUMO").Copy
ActiveSheet.Cells.Copy
ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs Filename:="C:\users\andre\desktop\pedidos\" & SaveMeAs
End Sub

[fazerbem]

Eu quis dizer

Depois sera pego onde sera arquivada a planilha, neste caso dentro da C:\users\andre\desktop\pedidos\ = C32+H6

[alexandrevba]

Boa tarde!!

Mas você não tentou adaptar?

Veja esse exemplo de links.

o modelo abaixo, não deve resolver apenas tem pontos que vc pode precisar, os link, complementa o que vai precisar.

Código: Selecionar todos

Sub AleVBA_480V2()
    'Favor consultar:
    'http://www.globaliconnect.com/excel/index.php?option=com_content&view=article&id=185:excel-vba-workbooks-reference-open-add-name-save-activate-copy-a-close-workbooks-sendmail-method&catid=79&Itemid=475&showall=&limitstart=3
    'Veja também
    'https://sites.google.com/a/madrocketscientist.com/jerrybeaucaires-excelassistant/save-functions/saveas-incremental
    'Como capturar o diretório nas células veja:
    'http://chandoo.org/wp/2012/04/09/consolidate-data-from-different-excel-files-vba/
    Dim sFileName As String, SFilePath As String
     
    sFileName = ThisWorkbook.Name 'Ou use o ActiveWorkbook
    SFilePath = Worksheets("RESUMO").Range("A32").Value '"C:\users\andre\desktop\pedidos\"
     
    Application.ScreenUpdating = False
        On Error GoTo errcather
            Sheets(Array("RESUMO", "LANÇAR COMISSAO", "PRODUTOS")).Copy 'Acrescente mais guias se necessário
        On Error GoTo 0
        ActiveWorkbook.SaveAs Filename:=SFilePath & sFileName
    ActiveWorkbook.Close Savechanges:=False
     
errcather:
    MsgBox "Uma ou mais planilhas não existe nesta pasta de trabalho"
     
    Application.ScreenUpdating = True
     
End Sub

Obs: As restrições devem ser tratadas, tipo guia com senha etc...caso contrário havera erro em tempo de execução.

Att

[fazerbem]

Alexandre, é que nao saco nada de VBA, as adaptacoes que fiz na sua Macro, foi porque foi facil fazer, dai como vc tem o arquivo que enviei no post anterior, nao daria pra vc me fazer esta macro e enviar em arquivo.

Sendo que no codigo acima, vc continua pondo o caminho na macro

SFilePath = Worksheets("RESUMO").Range("A32").Value '"C:\users\andre\desktop\pedidos\" , ao inves disso poderia ser:

SFilePath = Worksheets("RESUMO").Range("A32").Value '"G32" ? 'porque o A32 ao lado ?

[fazerbem]

Alexandre, consegui fazer, porem usei algo parecido.

Usei duas Macros.

1º Macro - Salvar Comissao + Limpar Parametros , segue modelo

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:AG2").Copy 'Copia o intervalo AB2:AG2 da guia Resumo
Dest.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Application.CutCopyMode = False 'Desativaj o clipboard

Ws1.Range("H10:J11,H20:H25").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 Caminho As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [C32].Value & ".xlsm"
MsgBox ("Planilha Salva Como : ") & [C32].Value & ".xlsm" 'deixa a planilha limpa para o proximo pedido Por isso em C32 = Tabela de Pedidos

End Sub

2º Macro - Salvar Planilha com nome da Planilha Base. (pois ao executar a Macro acima o nome da Planilha nao se alterou,

Sub AleVBA_480()
On Error Resume Next
Dim Caminho As String 'declaracao da variável caminho
Caminho = ThisWorkbook.Path & "\"
ActiveWorkbook.SaveAs Filename:=Caminho & [H10].Value & ".xlsm" 'H10 sera o nome usado na gravacao da planilha
MsgBox ("Planilha Salva Como : ") & [H10].Value & ".xlsm"
End Sub


Eu pensei ate em colocar as duas macros num comando unico, mas ao colocar o comado da 2º Macro na parte superior da 1º Macro , deu erro, indicando duplicidade de comando, pois fiz assim conforme abaixo, entao deixei mesmo em 2 botoes separados.


Perceba que usei H10 em cima e C32 em baixo
onde H10 e o nome que sera gravado a planilha e C32 o nome base da planilha pra quando aberta para um proximo pedido

---------------------------------------------------------------------------------------------------------------------------------------------

Sub Salvar_Pedido()

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"

'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:AG2").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:H25").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 Caminho 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




Muito obrigado por sua ajuda

Andre

[fazerbem]

Achei aqui:

http://br.ccm.net/forum/affich-316458-s ... -da-celula

[alexandrevba]

Bom dia!!

Eu fico feliz que conseguiu adaptar seu projeto!

Há mais alguma dúvida, caso não houver, pode marcar como resolvido.

Att