Excel Criar macro para atualizar arquivos mensalmente

[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

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