RudolfS

Mudei e ainda não resolveu

Não, como faço para colocar o local correto?

Sub eCOMMERCE() ' ' eCOMMERCE Macro ' ' Atalho do teclado: Ctrl+Shift+E ' Sheets("E-COMMERCE").Select End Sub Sub RASTREIO() ' ' RASTREIO Macro ' ' Atalho do teclado: Ctrl+Shift+R ' Sheets("Rastreamento").Select End Sub Sub CONTRATOS() ' ' CONTRATOS Macro ' ' Atalho do teclado: Ctrl+Shift+C ' Sheets("Contratos").Select End Sub Sub MULTIPRE() ' ' MULTIPRE Macro ' ' Atalho do teclado: Ctrl+Shift+M ' Sheets("MULTI PRÉ").Select End Sub Sub NOVOS() ' ' NOVOS Macro ' ' Atalho do teclado: Ctrl+Shift+N ' Sheets("BaseC").Select End Sub Sub SALVAR() ' ' SALVAR Macro ' ' Atalho do teclado: Ctrl+Shift+S ' ActiveWorkbook.Save End Sub Sub Fechamento(ByVal destinatario As String, body As String) Dim Nome As String Dim SDate As String Dim MyLocal As String Dim nomeArquivo As String MyLocal = "D:\Gestão\" 'MyLocal = "C:\Users\Jeferson\Desktop\Proj mototurbo\pdfs\" Nome = Sheets("FM").Range("C2").Value & ".pdf" nomeArquivo = MyLocal & Nome SDate = Now If Nome <> vbNullString Then Sheets("FM").ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyLocal & Nome, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'If InStr(1, destinatario, "@", 1) <> 0 Then ' Call Envio(nomeArquivo, destinatario, body) 'End If Else MsgBox "Nome do arquivo inválido", vbOKOnly, "Salvo" End If End Sub Sub FCP(ByVal destinatario As String, body As String) Dim Nome As String Dim SDate As String Dim MyLocal As String Dim nomeArquivo As String MyLocal = "D:\Gestão\" 'MyLocal = "C:\Users\Jeferson\Desktop\Proj mototurbo\pdfs_fcp\" Nome = Sheets("FCP").Range("j4").Text & ".pdf" nomeArquivo = MyLocal & Nome SDate = Now If Nome <> vbNullString Then Sheets("FCP").ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomeArquivo, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 'If InStr(1, destinatario, "@", 1) <> 0 Then ' Call Envio(nomeArquivo, destinatario, body) 'End If Else MsgBox "Nome do arquivo inválido", vbOKOnly, "Salvo" End If End Sub Sub remover_duplicadas(ByVal j As Integer) Application.ScreenUpdating = False Dim i As Integer i = 2 Sheets("BaseAuxiliar").Activate If j = 1 Then Sheets("BaseAuxiliar").Range("B2:B3428").Select Selection.ClearContents Sheets("BaseAuxiliar").Range("A1:A3428").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "B1"), Unique:=True Sheets("BaseAuxiliar").Range("d2").Select Do While i <= 642 If Sheets("BaseAuxiliar").Range("B" & i).Text <> "" And Len(Sheets("BaseAuxiliar").Range("B" & i).Text) > 0 Then Sheets("FM").Range("$A$12:$P$435").AutoFilter Field:=8, Criteria1:=Sheets("BaseAuxiliar").Range("B" & i).Text Sheets("FM").ListObjects("Tabela1").Range.AutoFilter Field:=8, Criteria1:=Sheets("BaseAuxiliar").Range("B" & i).Text Call Fechamento(Sheets("BaseAuxiliar").Range("c" & i).Text, Sheets("BaseAuxiliar").Range("d" & i).Text) 'Call Fechamento("[email protected]", Sheets("BaseAuxiliar").Range("d" & i).Text) End If i = i + 1 Loop Sheets("FM").Range("$A$12:$P$435").AutoFilter Field:=8 Sheets("FM").ListObjects("Tabela1").Range.AutoFilter Field:=8 'MsgBox "Deixa sem mensagem" ElseIf j = 2 Then Sheets("BaseAuxiliar").Range("g2:g435").Select Selection.ClearContents Sheets("BaseAuxiliar").Range("f1:f435").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _ "g1"), Unique:=True Do While i <= 424 If Sheets("BaseAuxiliar").Range("G" & i).Text <> "" Then Sheets("FCP").Range("$A$19:$O$441").AutoFilter Field:=7, Criteria1:="MULTI PRÉ" Sheets("FCP").Range("$A$19:$O$441").AutoFilter Field:=15, Criteria1:="NÃO" Sheets("FCP").Range("$A$19:$O$441").AutoFilter Field:=5, Criteria1:=Sheets("BaseAuxiliar").Range("G" & i).Text Call FCP(Sheets("BaseAuxiliar").Range("h" & i).Text, Sheets("BaseAuxiliar").Range("i" & i).Text) End If ' 'ActiveSheet.Range("$A$19:$O$442").AutoFilter Field:=7 'ActiveSheet.Range("$A$19:$O$442").AutoFilter Field:=15 i = i + 1 Loop Sheets("FCP").Range("$A$19:$O$442").AutoFilter Field:=5 End If End Sub Sub gerar_fcp() Call remover_duplicadas(2) 'MsgBox "Concluído" End Sub Sub gerar_um_fcp() Call FCP("teste", "teste") 'MsgBox "Concluído" End Sub Sub gerar_um_fm() Call Fechamento("teste", "teste") 'MsgBox "Concluído" End Sub Sub gerar_fm() Call remover_duplicadas(1) 'MsgBox "Concluído" End Sub Sub Envio(ByVal path1 As String, destinatario As String, body As String) Dim OutApp As Outlook.Application Dim OutMail As Outlook.MailItem 'Criação e chamada do Objeto Outlook 'verifica se o Outlook está aberto, caso não esteja, cria nova instância Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(olMailItem) Application.DisplayAlerts = False With OutMail .To = destinatario .CC = "" .BCC = "[email protected]" .Subject = "Fechamento " & Sheets("FM").Range("C1").Text .HTMLBody = "Olá " & body & ". <br><br>Segue anexo seu fechamento semanal referente ao Período de " & Sheets("BaseAuxiliar").Range("K2") 'O trecho abaixo anexa a planilha ao e-mail .Attachments.Add path1 .send 'Ou .Display para mostrar o email End With Application.DisplayAlerts = True 'Resetando a sessão Set OutMail = Nothing Set OutApp = Nothing End Sub Boas amigo, salvei acima. Não sei se por estar usando o arquivo em um notebook diferente está impedindo de gerar o PDF, visto que tem um endereço de e-mail diferente no código acima.

Ao clicar num macro que gera PDF a partir de dados da planilha, aparece Erro em tempo de execução '13', ao depurar aparece que o erro é: Nome = Sheets("FM").Range("C2").Value & ".pdf"