Guru do Excel e Power BI

Boa noite,

Gostaria de gerar arquivos excel.xlsm com base em um arquivo específico (MATRIZ.xlsm) e uma lista em uma coluna com os nomes para renomear conforme for criando os arquivos.

Tenho um código que faz isso, porém ele está gerando arquivos com base no que estou usando, queria que buscasse o arquivo (MATRIZ.xlsm).

Sub CriarArquivosXLSM()
'On Error Resume Next

Dim LIN As Long, totLIN As Long
Dim Endereco As String, Nome As String

'Plan2.Rows(1).EntireRow.Delete

totLIN = Plan4.Range("A" & Rows.Count).End(xlUp).Row

For LIN = 1 To totLIN

Endereco = ThisWorkbook.Path & Plan3.Range("L1").Value
Endereco = Plan3.Range("L2").Value

Nome = Plan3.Range("L1").Value & "MATRIZ.xlsm"
Nome = Plan4.Cells(LIN, 1).Value & ".xlsm"

ThisWorkbook.SaveCopyAs Endereco & Nome

Next

MsgBox "Os Arquivos Excel Foram Gerados Com Sucesso...!"

End Sub

Sei que o problema está nesta parte da linha "ThisWorkbook.Path", já tentei alterar e não funciona, continua pegando meu arquivo corrente e gerando os outros.

Att,
Francisco

Veja se lhe ajuda.

1. considerei que a lista com os nomes a serem atribuídos às cópias do arquivo MATRIZ.xlsm estará na coluna A, a partir de A1, da planilha ativa.
2. o arquivo MATRIZ.xlsm também deverá estar aberto ao rodar o código abaixo
3. as cópias serão gravadas na pasta em que está gravado o arquivo MATRIZ.xlsm

Sub CópiasDeMatriz()
Dim r As Range
Application.ScreenUpdating = False
For Each r In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
Workbooks("MATRIZ.xlsm").SaveCopyAs r.Value & " MATRIZ.xlsm"
Next r
End Sub

Bom dia osvaldomp

Obrigado por responder.

Não vai dar certo, porque eu vou estar em outro arquivo Excel VBA aberto, é apartir dele que vou executar as tarefas.
No caso, vou estar com o arquivo "ROTINAS DO SISTEMA", e nele vai ter o botão "GERAR PLANILHAS", quando eu clicar nele é para ir na aba "Auxiliar", na Coluna A à partir da linha 2 onde vai estar a lista com o nome dos arquivos que gostaria que fosse gerado. O código vai buscar o arquivo "MATRIZ" na pasta corrente (onde está o arquivo ROTINAS DO SISTEMA", vai criando os arquivo e renomeando e salvando em outra pasta "C:\HC".
Teria como executar dessa forma !?

Agradeço desde já.

Att,
Francisco

Olá, @fcarlosc2018.

Entendi. Veja se esse código abaixo faz o que você deseja.
____________________________________________________________________________________________________
Sub CópiasDeMatrizV2()
Dim r As Range, wb As Workbook
Application.ScreenUpdating = False
Set wb = Workbooks.Open(ThisWorkbook.Path & "\MATRIZ.xlsm")
With ThisWorkbook.Sheets("Auxiliar")
For Each r In .Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row)
wb.SaveCopyAs "C:\HC\" & r.Value & " MATRIZ.xlsm"
Next r
End With
wb.Close
End Sub
____________________________________________________________________________________________________

Boa noite osvaldomp

Funcionou parcialmente, assim que clico para gerar ele abre o arquivo "MATRIZ" no modo VBA, abre o formulário, aí tenho que acessar a planilha primeiro pra ele começar a fazer as cópias e depois tenho que salvar.
Más tá realizando a tarefa.

Att,
Francisco

As suas informações são incompletas e imprecisas, então fica difícil de resolver pois SEMPRE fica alguma pendência que não foi tratada antes, e essa situação meio que desanima e desestimula quem tenta lhe ajudar.

O código que passei faz as seguintes operações, compatíveis com as suas informações:
1. abre o arquivo MATRIZ, que está salvo na mesma Pasta Windows em que está salvo o arquivo que contém a macro
2. salva cópias do arquivo MATRIZ com nomes conforme a listagem de nomes contida na coluna A da planilha Auxiliar, planilha essa pertencente ao arquivo que contém a macro; as cópias são salvas em "C:\HC\"
3. por último fecha o arquivo MATRIZ
E para executar as operações acima a única intervenção requerida do operador é iniciar a execução do código.

Aí você comentou:
1. ele abre o arquivo "MATRIZ" no modo VBA, ... ~~~> o arquivo é aberto no modo Excel, e não no modo VBA
2. abre o formulário, .. ~~~> que formulário, até então você não havia se referido a qualquer formulário; qual é a influência do tal formulário no processo ora tratado ?
3. aí tenho que acessar a planilha primeiro ... ~~~> não entendi, precisa acessar qual planilha primeiro ? porque precisa acessar ?
4. pra ele começar a fazer as cópias ~~~> possivelmente existem mais algumas interferências no processo que você não informou antes, pois para o código fazer as cópias não é necessária qualquer intervenção sua além de iniciar a execução
5. e depois tenho que salvar.~~~> salvar o quê ?
6. Más tá realizando a tarefa. ~~~> você alega que o código funciona "parcialmente" visto que necessita de algumas intervenções suas, então a conclusão é NÃO ESTÁ REALIZANDO A TAREFA para a qual ele foi elaborado

dica - com base na documentação de cada aplicativo, a utilização de termos técnicos apropriados facilita o entendimento e transmite ideias exatas e precisas, pois melhor define cada situação; é aconselhável o seu uso ao invés do uso de linguagem figurativa

Boa tarde osvaldomp

Encontrei um código e fui adaptando para o que eu precisava e deu certo.

Sub CriarArquivosXLSM()

Dim listaNomes As Range
Dim nome As Variant
Dim arquivoOrigem As String
Dim pastaDestino As String
Dim arquivoDestino As String

' Defina a lista de nomes em uma coluna do Excel
Set listaNomes = ThisWorkbook.Sheets("Auxiliar").Range("A1:A200")

' Defina o caminho da pasta de origem (onde o arquivo será copiado)
PastaOrigem = "C:\HC\ROTINAS DO SISTEMA\MATRIZ\"

' Defina o caminho da pasta de destino (onde os arquivos serão copiados com os nomes da lista)
pastaDestino = "C:\HC\"

' Loop através dos nomes na lista
For Each nome In listaNomes
' Verifica se o nome não está vazio
If nome <> "" Then
' Define o caminho completo do arquivo de origem
arquivoOrigem = PastaOrigem & "MATRIZ.xlsm"

' Define o caminho completo do arquivo de destino com o nome da lista
arquivoDestino = pastaDestino & nome & ".xlsm"

' Copia o arquivo de origem para o arquivo de destino com o nome da lista
FileCopy arquivoOrigem, arquivoDestino
End If
Next nome

MsgBox "Os Arquivos Excel Foram Gerados Com Sucesso...!"

End Sub


Agradeço por responder.
Att,
Francisco