Bom dia!!

Consegue adaptar?
http://www.mrexcel.com/archive/VBA/2737b.html

Att

Desculpa Alexandre, não consegui adaptar!

Experimente assim:

Sub ExportaDados()
Dim Nome As String, NomeCopia As String, nPlan As String, Caminho As String
Dim sCaminho As String, sPath As String
Dim UltLinha As Long
'Define valores para as variaveis
'Guarda o nome da Planilha
nPlan = ActiveSheet.Name
'Guarda o nome do arquivo atual
Nome = ActiveWorkbook.Name
'Determina qual o local a ser salvo o novo arquivo
Caminho = "c:Pedidos de Venda"
sCaminho = Format(Date, "YYYY-MMM")
sPath = Caminho & sCaminho & ""
'Determina o nome para o novo arquivo
NomeCopia = "Pedido de Venda_" & Range("b4").Value & "_" & Format(Date, "dd-mmm-yyyy")
' Determina a qtde de planilhas no novo arquivo=1
'seleciona a planilha em questão
Sheets("Pedido").Select
'cria um novo arquivo
Sheets("Pedido").Copy

'Renomeia a nova planilha
ActiveSheet.Name = nPlan
'Verifica se o diretorio existe, se não existir, cria
    If (Dir(Caminho, vbDirectory) = "") Then
        MkDir (Caminho)
    End If
'Verifica se o sub diretorio existe, se não existir, cria
    If (Dir(sPath, vbDirectory) = "") Then
        MkDir (sPath)
    End If

'Verifica se o arquivo já existe, se existir, deleta
    If (Dir(sPath & NomeCopia & ".xlsx") <> "") Then
        Existe = MsgBox("  Arquivo Existente" & Chr(13) & _
                "Deseja Substitui-lo?", vbExclamation + vbYesNo, "Atenção")
        If Existe = vbYes Then
            Kill sPath & NomeCopia & ".xlsx"
        Else
            GoTo sai
        End If
    End If
               
'Salva o novo arquivo no caminho especificado
ActiveWorkbook.SaveAs sPath & NomeCopia & ".xlsx", CreateBackup:=False
'Fecha o novo arquivo
Windows(NomeCopia & ".xlsx").Close
Sheets(nPlan).Activate
Range("A3").Select
Application.CutCopyMode = False
'Retorna a qtde de planilhas ao padrão (3)
Application.SheetsInNewWorkbook = 3
sai:

    End Sub

Reinaldo, boa tarde!!!

Não querendo abusar, como ficaria o código acima se fosse para gerar o arquivo em PDF e sava-lo nas pasta criada.

Minha intenção é ter dois botões de comando:

Um com a opção de gerar o arquivo em excel; e

outro com a opção de gerar o arquivo em pdf.

Grato!

De uma olhada viewtopic.php?f=10&t=1046&hilit=+*pdf*&start=10

Reinaldo, tentei adapta-la

mas não estou conseguindo. Veja o código:

Sub Macro1()
Dim Pasta As String, MyPath As String, sMyPath As String, sPath As String

Pasta = ActiveSheet.Range("P1").Value
arq = "Pedido" & "-" & Range("b5").Value & " " & Format(Date, "dd-mmm-yyyy") & ".pdf"
MyPath = "c:Teste"
sMyPath = Format(Date, "YYYY-MMM")
sPath = MyPath & sMyPath & ""
'Indica em que local a pasta estará , pode ser C: ou d: ou e:....
'Verifica se o diretorio existe
If (Dir(MyPath, vbDirectory) = "") Then
MsgBox "Diretório - " & MyPath & Pasta & " - Não encontrado"
' se não existir, cria se quiser
 MkDir (MyPath)
End If

If (Dir(sPath, vbDirectory) = "") Then
        MkDir (sPath)
    End If

'Verifica se o arquivo já existe, se existir, deleta
'If (Dir(Arquivo) <> "") Then
' Kill Arquivo
'End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Path & Pasta & "" & arq, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

End Sub