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

@marmen

Acho que agora foi.

@teleguiado agora foi. Obrigado!

@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!

@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

@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.

@marmen

Células mescladas.

@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

@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

@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

@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...

@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

@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?

@marmen

Veja se nesse link não resolve seu problema.