Notifications
Clear all

CRIAR ARQUIVO .XLSM À PARTIR DE UMA LISTA

2 Posts
2 Usuários
0 Reactions
1,015 Visualizações
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

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

 
Postado : 16/11/2023 8:14 pm
(@osvaldomp)
Posts: 857
Prominent Member
 

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

Postado aqui também.

Osvaldo

 
Postado : 17/11/2023 6:15 pm