Macro ou VBA para c...
 
Notifications
Clear all

Macro ou VBA para copiar a Planilha para outra Pasta de Trabalho


marmen
Posts: 32
Registered
Topic starter
(@marmen)
Eminent Member
Entrou: 5 anos atrás

Olá, tudo bem com vocês??

Eu tenho um modelo de formulário mensal. Eu preciso que, ao final de cada mês, eu consiga, através de uma macro ou cód VBA copiar esse formulário para uma nova pasta de trabalho. E caso eu tente fazer isso de novo apareça uma mensagem falando que já foi copiada. Para não salvar duplicidades.

- Segue a planilha de Exemplo.

Fico no aguardo de uma resposta!!

Obrigado.

Responder
Tags do Tópico
28 Respostas
28 Respostas
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se é isso.

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado  Quase isso rsrs

Queria que copiasse somente a parte ativa da planilha ( A1:E23). E a partir do momento que eu escolher o nome do arquivo e o local ele salvasse automaticamente e fechasse a planilha recém salva.

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

 

Ja tentou gravar uma macro fazendo isso que você quer? E depois alterar conforme a sua necessidade?

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Tentei, porém, sem sucesso!

 

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se é isso.

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Isso mesmo. Tem como manter a formatação da planilha bem como largura e altura das linhas e colunas? Se tiver fica top demais!!

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se é assim.

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Isso mesmo. Obrigado!

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

Olá, tudo bem? 

Esse código me ajudou bastante mais precisava deixá-lo ainda mais funcional. Pois bem, deixa eu explicar,

Minha planilha possui 3 guias que precisam ser salvas e com esse código eu consigo salvar apenas uma guia, ou seja, preciso criar 3 botões e assim salvar em 3 planilhas.

Seria excelente criar um botão em uma das guias e quando acionado ele busca os dados da ex: plan1(A1E50) e salva em uma planilha.

 

Resumindo: preciso salvar dados de 3 guias de uma pasta de Trabalho através de apenas 1 botão em outra pasta de trabalho.

Grato!

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se te atende dessa forma.

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Esse modelo está com 3 botões que salva separadamente. E, eu preciso de um botão que salve as 3 planilhas ao mesmo tempo.

-Grato!

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se te atende desse jeito.

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Quase isso. Tem como o botão salvar as 3 de uma vez na mesma pasta de trabalho? o ideal é que a nova planilha seja um espelho dessa só o botão não precisa aparecer

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado continua salvando em 3 planilhas separadas. A questão de não aparecer o botão foi resolvido.

 

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Acho que agora foi.

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado agora foi. Obrigado!

 

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Consegue fazer 2 alterações nesse código, por gentileza! 
Primeiro: Gostaria que o cód. copiasse somente os valores, pois algumas células da guia tem referência com outra guia 

Segundo: Minha planilha está protegida por senha e quando eu uso esse código ela volta sem proteção. Pra tentar resolver fiz dessa forma mais não deu certo.

Option Explicit
Public fname, NomeArquivo As Variant

Sub Salvarformulario()

Sheets("Teste").Unprotect "senha"
ThisWorkbook.Activate

Dim msg, style, Title, Response, mystring
Dim UserName As String
Dim lpBuff As String * 25
NomeArquivo = Application.ThisWorkbook.Name
Application.ScreenUpdating = False

'
' Salvar a planilha em uma nova pasta de trabalho
'
msg = "Deseja salvar a Nota em um arquivo novo?"
style = vbYesNo + vbQuestion + vbDefaultButton2
Title = "Salvar Formulário"
Response = MsgBox(msg, style, Title)
If Response = vbYes Then

'
' Abre uma nova pasta de trabalho
'

Workbooks.Add
Do
fname = InputBox("Qual o nome do Arquivo?")
Loop Until fname <> False
'
' Salva a nova pasta de trabalho com o nome desejado
'
Application.Dialogs(xlDialogSaveAs).Show Arg1:=fname, Arg2:=xlOpenXMLWorkbook

'
' Copia a pagina Aprovall e salva por fname
'
Windows(NomeArquivo).Activate
Range("A5:G200").Select
Selection.Copy

' Sheets("Formulário").Copy Before:=Workbooks(Fname & ".xlsx").Sheets(1)

Windows(fname & ".xlsx").Activate
Range("A1:G200").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Range("a1").Select
Application.DisplayAlerts = False
ThisWorkbook.Save
End If
Application.ScreenUpdating = True

Sheets("Teste").Protect "senha"
ThisWorkbook.Activate

End Sub

 

-----Grato!

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se deu certo.

 

Option Explicit
Public fname, NomeArquivo As Variant

Sub Salvarformulario()

Sheets("Teste").Unprotect Password:="senha"
ThisWorkbook.Activate

Dim msg, style, Title, Response, mystring
Dim UserName As String
Dim lpBuff As String * 25
NomeArquivo = Application.ThisWorkbook.Name
Application.ScreenUpdating = False

'
' Salvar a planilha em uma nova pasta de trabalho
'
msg = "Deseja salvar a Nota em um arquivo novo?"
style = vbYesNo + vbQuestion + vbDefaultButton2
Title = "Salvar Formulário"
Response = MsgBox(msg, style, Title)
If Response = vbYes Then

'
' Abre uma nova pasta de trabalho
'

Workbooks.Add
Do
fname = InputBox("Qual o nome do Arquivo?")
Loop Until fname <> False
'
' Salva a nova pasta de trabalho com o nome desejado
'
Application.Dialogs(xlDialogSaveAs).Show Arg1:=fname, Arg2:=xlOpenXMLWorkbook

'
' Copia a planilha e salva na nova pasta de trabalho criada
'
Windows(NomeArquivo).Activate
Range("A5:G200").Select
Selection.Copy

' Sheets("Formulário").Copy Before:=Workbooks(Fname & ".xlsx").Sheets(1)

Windows(fname & ".xlsx").Activate
Range("A1:G200").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.CutCopyMode = False
Range("a1").Select
Application.DisplayAlerts = False
ThisWorkbook.Save
End If
Application.ScreenUpdating = True

Windows(NomeArquivo).Activate
Sheets("Teste").Protect Password:="senha"

End Sub
Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Segue o erro que apareceu no final ao executar o código. E a planilha não ficou protegida após eu ter usado o código.

 

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Células mescladas.

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Teste desse jeito.

Option Explicit
Public fname, NomeArquivo As Variant

Sub Salvarformulario()

Sheets("Teste").Unprotect Password:="senha"
ThisWorkbook.Activate

Dim msg, style, Title, Response, mystring
Dim UserName As String
Dim lpBuff As String * 25
NomeArquivo = Application.ThisWorkbook.Name
Application.ScreenUpdating = False

'
' Salvar a planilha em uma nova pasta de trabalho
'
msg = "Deseja salvar a Nota em um arquivo novo?"
style = vbYesNo + vbQuestion + vbDefaultButton2
Title = "Salvar Formulário"
Response = MsgBox(msg, style, Title)
If Response = vbYes Then

'
' Abre uma nova pasta de trabalho
'

Workbooks.Add
Do
fname = InputBox("Qual o nome do Arquivo?")
Loop Until fname <> False
'
' Salva a nova pasta de trabalho com o nome desejado
'
Application.Dialogs(xlDialogSaveAs).Show Arg1:=fname, Arg2:=xlOpenXMLWorkbook

'
' Copia a planilha e salva na nova pasta de trabalho criada
'
Windows(NomeArquivo).Activate
Range("A5:G200").Select
Selection.Copy

' Sheets("Formulário").Copy Before:=Workbooks(Fname & ".xlsx").Sheets(1)

Windows(fname & ".xlsx").Activate
Range("A1:G200").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


Application.CutCopyMode = False
Range("a1").Select
Application.DisplayAlerts = False
ThisWorkbook.Save
End If
Application.ScreenUpdating = True

Windows(NomeArquivo).Activate
Sheets("Teste").Protect Password:="senha"

End Sub
Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Deu certo, obrigado!

Uma ultima dúvida para fecharmos esse tópico com chave de ouro rsrs

Criei um código através de uma macro...como já disse não entendo muito de VBA 😆 

atribui um botão a essa macro com a função de excluir as informações de um conjunto de células. Eu queria que antes dessa exclusão ser feita aparecesse uma msgbox perguntando se quero realmente excluir aquele intervalo.

Segue o código:

Sub excluirLançamentos()
'
' excluirLançamentos Macro
'
ActiveWindow.SmallScroll Down:=-15
Range("C10:G10").Select

Sheets("teste").Unprotect "senha"

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

Sheets("teste").Protect "senha"

Range("C10").Select

End Sub

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen no código anterior tem o que você precisa.

 

Sub excluirLançamentos()
Dim msg, style, Title, Response, mystring
'
' excluirLançamentos Macro
'
msg = "Deseja Excluir Lançamentos?"
style = vbYesNo + vbQuestion + vbDefaultButton2
Title = "Excluir Lançamento"
Response = MsgBox(msg, style, Title)
If Response = vbYes Then
ActiveWindow.SmallScroll Down:=-15
Range("C10:G10").Select

Sheets("teste").Unprotect "senha"

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

Sheets("teste").Protect "senha"

Range("C10").Select
End If
End Sub
Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado BOA TARDE

o código para salvar a planilha está funcionando perfeitamente!!

Só que tem um porém, preciso que o código funcione para o excel em um MacBook. Não sei se seria possível...

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Talvez seja porque tem diferença da versão para o windows da versão pra macbook. Veja no link abaixo as funções que tem no windows e não tem no mac e veja se não esta usando alguma função que não é compativel com o mac.

 

Link

Responder
marmen
Registered
(@marmen)
Entrou: 5 anos atrás

Eminent Member
Posts: 32

@teleguiado Todos os outros recursos funcionaram. Será que não é porque esse código usa a janela de salvamento do windows. Não teria um código diferente para o sistema operacional do Mac?

Responder
teleguiado
Registered
(@teleguiado)
Entrou: 6 anos atrás

Estimable Member
Posts: 138

@marmen

Veja se nesse link não resolve seu problema.

 

Responder