Esdras Pelegrin

Boa tarde Lidiane De uma olhada no código abaixo, tentei anexar a planilha mas não consegui, o único problema é que tem que copiar o código para cada conta, acho que da para melhorar, mas ainda estou começando também. Coloquei para salvar em excel, caso não precise basta eliminar o código. Eu criei um botão e atribui a macro "Extrair_Conta" a ele. Espero que ajude. Dim Nome_Conta As Variant Sub Extrair_Conta() '1º Conta 'Realiza um filtro com base por projeto e armazena o nome do projeto na variavel Nome_Conta ActiveSheet.Range("$A:$F").AutoFilter Field:=1, Criteria1:="=22654000" Nome_Conta = "Conta 22654000" 'cria uma nova planilha e copia e cola o conteudo filtrado acima e salva com o nome do projeto 'Deve ser alterado o local onde será salva a planilha Range("A9").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Workbooks.Add ActiveSheet.Paste Selection.Columns.AutoFit Application.CutCopyMode = False ChDir "C:\Users\esdras.pelegrin\Desktop" ActiveWorkbook.SaveAs Filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Conta & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.ActivateNext 'Altera a orientação para paisagem ActiveSheet.PageSetup.Orientation = xlLandscape 'Salva a Planilha em PDF sem abrir o PDF, se "openafterpublish:= Sim" ele abre o PDF 'Deve ser alterado o local onde será salva a planilha ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Conta & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ openafterpublish:=False ChDir "C:\Users\esdras.pelegrin\Desktop" 'Seleciona uma planilha de acordo com o nome atribuido a variavel e fecha a mesma. Windows(Nome_Conta).Activate ActiveWindow.Close '----------------------------------------------------------------------------------------------------- '2º Conta 'Realiza um filtro com base por projeto e armazena o nome do projeto na variavel Nome_Conta ActiveSheet.Range("$A:$F").AutoFilter Field:=1, Criteria1:="=21207000" Nome_Conta = "Conta 21207000" 'cria uma nova planilha e copia e cola o conteudo filtrado acima e salva com o nome do projeto Range("A9").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Workbooks.Add ActiveSheet.Paste Selection.Columns.AutoFit Application.CutCopyMode = False ChDir "C:\Users\esdras.pelegrin\Desktop" ActiveWorkbook.SaveAs Filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Conta & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.ActivateNext 'Altera a orientação para paisagem ActiveSheet.PageSetup.Orientation = xlLandscape 'Salva a Planilha em PDF sem abrir o PDF, se "openafterpublish:= Sim" ele abre o PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Conta & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ openafterpublish:=False ChDir "C:\Users\esdras.pelegrin\Desktop" 'Seleciona uma planilha de acordo com o nome atribuido a variavel e fecha a mesma. Windows(Nome_Conta).Activate ActiveWindow.Close 'Limpa todos os filtros Selection.AutoFilter Range("A9:I9").Select Selection.AutoFilter Range("A1").Select MsgBox "Processo Finalizado" End Sub adicionado 43 minutos depois Segue a macro com a alteração para apenas gerar gerar o PDF Dim Nome_Conta As Variant Sub Extrair_Conta() '1º Conta 'Realiza um filtro por conta e armazena o nome da Conta na variavel Nome_Conta ActiveSheet.Range("$A:$F").AutoFilter Field:=1, Criteria1:="=22654000" Nome_Conta = "Conta 22654000" 'Altera a orientação para paisagem ActiveSheet.PageSetup.Orientation = xlLandscape 'Salva a Planilha em PDF sem abrir o PDF, se "openafterpublish:= Sim" ele abre o PDF 'Deve ser alterado o local onde será salva a planilha ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Conta & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ openafterpublish:=False ChDir "C:\Users\esdras.pelegrin\Desktop" '----------------------------------------------------------------------------------------------------- '2º Conta 'Realiza um filtro por conta e armazena o nome da Conta na variavel Nome_Conta ActiveSheet.Range("$A:$F").AutoFilter Field:=1, Criteria1:="=21207000" Nome_Conta = "Conta 21207000" 'Altera a orientação para paisagem ActiveSheet.PageSetup.Orientation = xlLandscape 'Salva a Planilha em PDF sem abrir o PDF, se "openafterpublish:= Sim" ele abre o PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Conta & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ openafterpublish:=False ChDir "C:\Users\esdras.pelegrin\Desktop" '----------------------------------------------------------------------------------------------------- 'Limpa todos os filtros Selection.AutoFilter Range("A9:I9").Select Selection.AutoFilter Range("A1").Select MsgBox "Processo Finalizado" End Sub

ele cria o arquivo sem abrir o PDF, entendi, obrigado pela resposta

Boa tarde pessoal Sou novo aqui e gosto bastante de Excel e estou dando os primeiros passos no que diz respeito a macro, fiz uma macro que realiza um filtro, seguida copia o conteúdo filtrado, salva a nova planilha, cria um pdf dessa nova planilha, o que não consegui até o momento foi fechar o PDF. Segue abaixo os códigos, se alguém puder me ajudar. Dim Nome_Projeto As Variant Sub Extrair_Projetos() 'Realiza um filtro com base por projeto e armazena o nome do projeto na variavel Nome_Projeto ActiveSheet.Range("$A:$G").AutoFilter Field:=7, Criteria1:="=000000" Nome_Projeto = "Projeto 000000" 'cria uma nova planilha e copia e cola o conteudo filtrado acima e salva com o nome do projeto Range("A3").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Workbooks.Add ActiveSheet.Paste Selection.Columns.AutoFit Application.CutCopyMode = False ChDir "C:\Users\esdras.pelegrin\Desktop" ActiveWorkbook.SaveAs filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Projeto & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.ActivateNext 'Salva a Planilha em PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Projeto & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ openafterpublish:=True ChDir "C:\Users\esdras.pelegrin\Desktop" 'Seleciona uma planilha de acordo com o nome atribuido a variavel e fecha a mesma. Windows(Nome_Projeto).Activate ActiveWindow.Close 'Realiza um filtro com base por projeto e armazena o nome do projeto na variavel Nome_Projeto ActiveSheet.Range("$A:$G").AutoFilter Field:=7, Criteria1:="=000062" Nome_Projeto = "Projeto 000062" 'cria uma nova planilha e copia e cola o conteudo filtrado acima e salva com o nome do projeto Range("A3").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy Workbooks.Add ActiveSheet.Paste Selection.Columns.AutoFit Application.CutCopyMode = False ChDir "C:\Users\esdras.pelegrin\Desktop" ActiveWorkbook.SaveAs filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Projeto & ".xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.ActivateNext 'Salva a Planilha em PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _ "C:\Users\esdras.pelegrin\Desktop\" & Nome_Projeto & ".pdf", Quality:= _ xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ openafterpublish:=True ChDir "C:\Users\esdras.pelegrin\Desktop" 'Seleciona uma planilha de acordo com o nome atribuido a variavel e fecha a mesma. Windows(Nome_Projeto).Activate ActiveWindow.Close 'Limpa todos os filtros Selection.AutoFilter Range("A3:I3").Select Selection.AutoFilter Range("A1").Select MsgBox "Processo Finalizado" End Sub