Cfernandes

Olá, Eu preciso todo mês pegar um arquivo da pasta “Arquivos passados” copiar para a planilha “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” – todo mês ela muda e muda seu nome, mas sempre é salva no mesmo lugar – copio para dentro dessa planilha e salvo como um novo arquivo com o final diferente, quando possui planilha com mesmo nome eu aceito copiar mudar o nome para (2) por exemplo. Exemplo, eu abro o arquivo: BR_112345586_XX24Q5M8 (todo mês pode ter um nome diferente, mas sempre estarão na mesma pasta) e copio todas as planilhas dentro do arquivo “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” e dou um salvar como em “Arquivos atualizados” com o mesmo padrão do arquivo original entretanto mudo o final conforme a célula B3 da planilha parâmetros: BR_112345586_ XX25Q6M9. Eu não posso copiar “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” para BR_112345586_XX24Q5M8 porque tem um saldos por traz. Depois eu copio os dados da célula D3 e D4 da planilha “Conciliation Template (2)” que se refere ao arquivo passado e colo no mesmo lugar da planilha “Conciliation Template” que é a nova do arquivo. Depois eu pegos os dados do intervalor B24:E30 de “Conciliation Template (2)” e copio para a planilha “Conciliation Template” e excluo a planilha “Conciliation Template (2)” e Support Template (2) e salvo. · C:\Conciliações\Arquivos - “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” · C:\Conciliações\Arquivos\Arquivos passado – onde estão salvos os arquivos que tem as informações e precisam ser copiadas para a nova · Local onde deve ser salvo os novos lugares: C:\Conciliações\Arquivos\Arquivos atualizados · C:\Conciliações: Onde tem o arquivo de parâmetros com o final do nome que deve ser atualizado (não estou conseguindo subir o zip das pastas, então subi as pastas e o print da estrutura das pastas) Tentei o código abaixo, mas não tive sucesso: Sub CopyAndSaveExcelFiles() Dim folderPath As String Dim templateFile As String Dim sourceFile As String Dim filePattern As String Dim templateWB As Workbook Dim sourceWB As Workbook Dim newEnding As String Dim newFileName As String Dim destFile As String Dim sourceSheet As Worksheet Dim copiedSheet As Worksheet Dim sheetNewName As String Dim attemptToCopy As Boolean On Error GoTo ErrorHandler ' Controle de erros folderPath = "C:\Nova pasta (2)\Conciliações BR\" templateFile = Dir(folderPath & "Reconciliation Template*.xlsb", vbNormal) If templateFile <> "" Then Set templateWB = Workbooks.Open(folderPath & templateFile, UpdateLinks:=False) newEnding = templateWB.Sheets(1).Range("B3&quot.Value Else MsgBox "Arquivo de template não encontrado.", vbExclamation Exit Sub End If filePattern = "*.xlsb" sourceFile = Dir(folderPath & filePattern, vbNormal) Do While sourceFile <> "" If sourceFile <> templateFile Then Set sourceWB = Workbooks.Open(folderPath & sourceFile, UpdateLinks:=False) For Each sourceSheet In sourceWB.Worksheets attemptToCopy = False sheetNewName = sourceSheet.Name ' Verificar se a planilha está protegida If sourceSheet.ProtectContents Then MsgBox "A planilha " & sourceSheet.Name & " está protegida. Desproteja antes de copiar.", vbExclamation Else ' Tentar copiar a planilha e verificar a falha On Error Resume Next sourceSheet.Copy After:=templateWB.Sheets(templateWB.Sheets.Count) If Err.Number = 0 Then Set copiedSheet = templateWB.Sheets(templateWB.Sheets.Count) attemptToCopy = True End If On Error GoTo 0 If attemptToCopy Then ' Verifica se o nome já existe e renomeia se necessário If IsSheetNameExists(templateWB, sheetNewName) Then sheetNewName = GenerateUniqueSheetName(templateWB, sheetNewName) End If copiedSheet.Name = sheetNewName Set copiedSheet = Nothing Else MsgBox "Falha ao copiar a planilha: " & sourceSheet.Name, vbExclamation End If End If Next sourceSheet newFileName = Left(sourceFile, InStrRev(sourceFile, ".&quot - 1) & "_" & newEnding & ".xlsb" destFile = folderPath & newFileName templateWB.SaveAs destFile, FileFormat:=50 sourceWB.Close SaveChanges:=False End If sourceFile = Dir() Loop templateWB.Close SaveChanges:=False MsgBox "Processo concluído com sucesso!", vbInformation Exit Sub ErrorHandler: MsgBox "Ocorreu um erro: " & Err.Description, vbExclamation If Not sourceWB Is Nothing Then sourceWB.Close SaveChanges:=False If Not templateWB Is Nothing Then templateWB.Close SaveChanges:=False End Sub Function IsSheetNameExists(ByVal wb As Workbook, ByVal sheetName As String) As Boolean Dim ws As Worksheet On Error Resume Next Set ws = wb.Sheets(sheetName) IsSheetNameExists = Not ws Is Nothing On Error GoTo 0 End Function Function GenerateUniqueSheetName(ByVal wb As Workbook, ByVal baseName As String) As String Dim num As Integer Dim newName As String num = 1 newName = baseName Do While IsSheetNameExists(wb, newName) num = num + 1 newName = baseName & "_" & num Loop GenerateUniqueSheetName = newName End Function 283211_ab94f337-b91f-4e7d-aed0-24e306caa292.docx

@ricardo_br @ricardo_br tentei fazer pelo código desse link e me da erro nesse trecho para salvar indivudual: ExportFormat:=wdExportFormatPDF, _ Range:=wdExportFromTo, From:=i, To:=i Depois tentei seguir o passo a passo do vídeo: Mas o erro do código foi: singleDoc.SaveAs2 _ FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _ masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _ FileFormat:=wdFormatXMLDocument ' Save "singleDoc" as a word docx with the details provided in the DocFolderPath and DocFileName fields in the MailMerge data singleDoc.ExportAsFixedFormat _ Código completo: Sub MailMergeToPdfBasic() ' Mark the start of the Subroutine (i.e. Macro) and name it "MailMergeToPdf" ' Macro created by Imnoss Ltd ' Please share freely while retaining attribution ' Last Updated 2021-05-03 Dim masterDoc As Document, singleDoc As Document, lastRecordNum As Long ' Create variables ("Post-it Notes") for later use Set masterDoc = ActiveDocument ' Identify the ActiveDocument (foremost doc when Macro run) as "masterDoc" masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord ' jump to the last active record (active = ticked in edit recipients) lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord ' retrieve the record number of the last active record so we know when to stop masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord ' jump to the first active record (active = ticked in edit recipients) Do While lastRecordNum > 0 ' create a loop, lastRecordNum is used to end the loop by setting to zero (see below) masterDoc.MailMerge.Destination = wdSendToNewDocument ' Identify that we are creating a word docx (and no e.g. an email) masterDoc.MailMerge.DataSource.FirstRecord = masterDoc.MailMerge.DataSource.ActiveRecord ' Limit the selection to just one document by setting the start ... masterDoc.MailMerge.DataSource.LastRecord = masterDoc.MailMerge.DataSource.ActiveRecord ' ... and end points to the active record masterDoc.MailMerge.Execute False ' run the MailMerge based on the above settings (i.e. for one record) Set singleDoc = ActiveDocument ' Identify the ActiveDocument (foremost doc after running the MailMerge) as "singleDoc" singleDoc.SaveAs2 _ FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _ masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _ FileFormat:=wdFormatXMLDocument ' Save "singleDoc" as a word docx with the details provided in the DocFolderPath and DocFileName fields in the MailMerge data singleDoc.ExportAsFixedFormat _ OutputFileName:=masterDoc.MailMerge.DataSource.DataFields("PdfFolderPath").Value & Application.PathSeparator & _ masterDoc.MailMerge.DataSource.DataFields("PdfFileName").Value & ".pdf", _ ExportFormat:=wdExportFormatPDF ' Export "singleDoc" as a PDF with the details provided in the PdfFolderPath and PdfFileName fields in the MailMerge data singleDoc.Close False ' Close "singleDoc", the variable "singleDoc" can now be used for the next record when created If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then ' test if we have just created a document for the last record lastRecordNum = 0 ' if so we set lastRecordNum to zero to indicate that the loop should end Else masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord ' otherwise go to the next active record End If Loop ' loop back to the Do start End Sub Mesmo estando com nome como oreintado: Formularios.zip

Olá, tenho uma mala direta com 1.400 páginas, a cada duas páginas é um documento referente a um cliente. Quero saber como posso salvar individualmente de cada cliente, pagina 1 e 2 salvar como: Carta - Cliente_ - art. 166 CTN 1, onde Cliente_ deve ser o nome que está nessas páginas que é um campo da lista da mala direta, depois pág 3 e 4: Carta - Cliente_ - art. 166 CTN 1 e etc.

Olá, Eu preciso todo mês pegar um arquivo da pasta “Arquivos passados” copiar para a planilha “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” – todo mês ela muda e muda seu nome, mas sempre é salva no mesmo lugar – copio para dentro dessa planilha e salvo como um novo arquivo com o final diferente, quando possui planilha com mesmo nome eu aceito copiar mudar o nome para (2) por exemplo. Exemplo, eu abro o arquivo: BR_112345586_XX24Q5M8 (todo mês pode ter um nome diferente, mas sempre estarão na mesma pasta) e copio todas as planilhas dentro do arquivo “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” e dou um salvar como em “Arquivos atualizados” com o mesmo padrão do arquivo original entretanto mudo o final conforme a célula B3 da planilha parâmetros: BR_112345586_ XX25Q6M9. Eu não posso copiar “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” para BR_112345586_XX24Q5M8 porque tem um saldos por traz. Depois eu copio os dados da célula D3 e D4 da planilha “Conciliation Template (2)” que se refere ao arquivo passado e colo no mesmo lugar da planilha “Conciliation Template” que é a nova do arquivo. Depois eu pegos os dados do intervalor B24:E30 de “Conciliation Template (2)” e copio para a planilha “Conciliation Template” e excluo a planilha “Conciliation Template (2)” e Support Template (2) e salvo. · C:\Conciliações\Arquivos - “Reconciliation Template (CódigoPaís_CódigoConta_FY25Q1M1)” · C:\Conciliações\Arquivos\Arquivos passado – onde estão salvos os arquivos que tem as informações e precisam ser copiadas para a nova · Local onde deve ser salvo os novos lugares: C:\Conciliações\Arquivos\Arquivos atualizados · C:\Conciliações: Onde tem o arquivo de parâmetros com o final do nome que deve ser atualizado Tentei o código abaixo, mas não tive sucesso: Sub CopyAndSaveExcelFiles() Dim folderPath As String Dim templateFile As String Dim sourceFile As String Dim filePattern As String Dim templateWB As Workbook Dim sourceWB As Workbook Dim newEnding As String Dim newFileName As String Dim destFile As String Dim sourceSheet As Worksheet Dim copiedSheet As Worksheet Dim sheetNewName As String Dim attemptToCopy As Boolean On Error GoTo ErrorHandler ' Controle de erros folderPath = "C:\Nova pasta (2)\Conciliações BR\" templateFile = Dir(folderPath & "Reconciliation Template*.xlsb", vbNormal) If templateFile <> "" Then Set templateWB = Workbooks.Open(folderPath & templateFile, UpdateLinks:=False) newEnding = templateWB.Sheets(1).Range("B3").Value Else MsgBox "Arquivo de template não encontrado.", vbExclamation Exit Sub End If filePattern = "*.xlsb" sourceFile = Dir(folderPath & filePattern, vbNormal) Do While sourceFile <> "" If sourceFile <> templateFile Then Set sourceWB = Workbooks.Open(folderPath & sourceFile, UpdateLinks:=False) For Each sourceSheet In sourceWB.Worksheets attemptToCopy = False sheetNewName = sourceSheet.Name ' Verificar se a planilha está protegida If sourceSheet.ProtectContents Then MsgBox "A planilha " & sourceSheet.Name & " está protegida. Desproteja antes de copiar.", vbExclamation Else ' Tentar copiar a planilha e verificar a falha On Error Resume Next sourceSheet.Copy After:=templateWB.Sheets(templateWB.Sheets.Count) If Err.Number = 0 Then Set copiedSheet = templateWB.Sheets(templateWB.Sheets.Count) attemptToCopy = True End If On Error GoTo 0 If attemptToCopy Then ' Verifica se o nome já existe e renomeia se necessário If IsSheetNameExists(templateWB, sheetNewName) Then sheetNewName = GenerateUniqueSheetName(templateWB, sheetNewName) End If copiedSheet.Name = sheetNewName Set copiedSheet = Nothing Else MsgBox "Falha ao copiar a planilha: " & sourceSheet.Name, vbExclamation End If End If Next sourceSheet newFileName = Left(sourceFile, InStrRev(sourceFile, ".") - 1) & "_" & newEnding & ".xlsb" destFile = folderPath & newFileName templateWB.SaveAs destFile, FileFormat:=50 sourceWB.Close SaveChanges:=False End If sourceFile = Dir() Loop templateWB.Close SaveChanges:=False MsgBox "Processo concluído com sucesso!", vbInformation Exit Sub ErrorHandler: MsgBox "Ocorreu um erro: " & Err.Description, vbExclamation If Not sourceWB Is Nothing Then sourceWB.Close SaveChanges:=False If Not templateWB Is Nothing Then templateWB.Close SaveChanges:=False End Sub Function IsSheetNameExists(ByVal wb As Workbook, ByVal sheetName As String) As Boolean Dim ws As Worksheet On Error Resume Next Set ws = wb.Sheets(sheetName) IsSheetNameExists = Not ws Is Nothing On Error GoTo 0 End Function Function GenerateUniqueSheetName(ByVal wb As Workbook, ByVal baseName As String) As String Dim num As Integer Dim newName As String num = 1 newName = baseName Do While IsSheetNameExists(wb, newName) num = num + 1 newName = baseName & "_" & num Loop GenerateUniqueSheetName = newName End Function Conciliações.zip

@Wendell Menezes muito obrigada! Funcionou muito bem!

Olá, gostaria de uma ajuda em uma macro para que seja consolidados dados de algum determinado lugar de planilhas do Excel em binários. A Macro deve sempre copiar os dados no mesmo lugar nas células de todos os arquivos que estão na pasta e consolidar as informações em uma nova planilha. Anexo os arquivos que possuem a estrutura e a base esperada. Destacado em amarelo os campos que devem ser copiados. Os arquivos que devem ter seus dados copiados possuem a estrutura padrão então não temos como modificar sua estrutura. Consolidado.zip

Olá, possuo uma equipe para cada país que atendemos no Teams e cada possui um canal de acordo com os assuntos. Cada equipe possui um app To Do com as atividades a serem realizadas. Entretanto, gostaria de ter a visão dos gráficos dos status no Sharepoint do andamento das atividades de todas as equipes. Hoje é possível integrar uma única equipe, mas gostaria de integrar as 12 equipes em uma única página do Sharepoint com o resumo da atividades de todas as equipes através do gráfico.

@Midori Muito obrigada! Gostaria apenas de entender como posso fazer com que os arquivos sejam descompactados dentro de uma única pasta criada, ou seja, todos os arquivos pdf (somete o arquivo, sem pasta e subpasta) que forem descompactados sejam copiados para uma pasta nova criada no mesmo diretório raiz que está a planilha (conforme imagem). Mas sem remover os duplicados, mantendo os arquivos mesmo que o nome seja duplicado. Exemplo de teste.zip

Olá! Prezado, preciso desenvolver uma macro que descompacte arquivos em lote, entretanto que não descompacte criando uma nova pasta, que seja descompactado todos os arquivos das pastas raiz. Como por exemplo, as duas pastas compactadas dentro do Exemplo 1 sejam descompactadas somente o arquivo dentro da pasta Exemplo 1, o mesmo para o exemplo 2. Teste\Arquivos 1\Exemplo 1 Também na pasta abaixo do exemplo, onde os arquivos das pastas compactadas sejam extraidas dentro de arquivos 2 e somente os arquivos. Teste\Arquivos 2 Teste.rar

@Basole Fiquei com uma dúvida, no caso a planilha atualiza sozinha a data de "HOJE" mesmo sem eu abri-la? E também envia sozinho o e-mail sem eu clicar o botão? A minha necessidade é deixar ela sozinha e ela me avisar quando um prazo está chegando sem eu entrar nela.

@-=|zami|=- é necessario que seja uma cor diferente por linha ou na tabela inteira conforme planilha3? Destaque.Duplicados.zip

Olá, gostaria de uma ajuda para que a planilha em anexo! Eu precisaria que ela atualiza-se automaticamente a data de hoje e enviasse um e-mail pelo Outlook de acordo com o Status da coluna "G. Os endereços de e-mails são todos iguais, mas inseri na coluna "H". Quando o status for VENCIDO, que envie um e-mail diário. Quando for mudar para ATUALIZAR, encaminhe um e-mail e novamente a cada dois dias. Quando estiver NO PRAZO, nada precisa ser feito. O e-mail pode ser: Assunto: Conta de (nome conforme coluna "A") - (Status conforme coluna "G") Corpo do e-mail: Atualização necessária da conta de (nome conforme coluna "A"). Controle de vencimentos.zip

@Basole muito obrigada! Funcionou certinho!

Planilha.zip

Olá, Gostaria de verificar o código para que no VBA considere no caminho de diretório a informação que eu colocar em uma célula. Exemplo: Tenho na planilha o campo ano a ser preenchido na célula A2, e quero que toda vez que eu inserir um ano diferente, 2020 por exemplo o código abaixo do diretório também mude para 2020. Ou seja, o caminho final do diretório abaixo onde tem "\2021\", deve mudar de acordo com a informação de A2. Const SUBPASTA_RELATORIO As String = _ "\EXTRAÇÃO\ERP\COMISSÕES\" & _ "PRESTADOR\PARTICIPAÇÃO\2021\" Planilha exemplo.zip