Excel Excel - Macro para salvar planilhas

[Scheila Dayane 1]

Olá Pessoal, Bom dia! 

Criei uma macro que gera e salva os arquivos num loop, a aba CONTRATOS dentro da planilha GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm chama o nome do arquivo pra salvar na Range ("B") . Porém os arquivos estão sendo salvos sobrepondo e sempre com o nome "0".

Já mexi de várias formas, mas nada faz ele salvar 1 aquivo por vez com o nome correto, acredito que o erro esteja na variável, alguém consegue me dar um help.

 

A planilha onde consta o modelo contrato é:  Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS/CONTRATO.xlsb

A planilha com a base onde gera os arquivos em massa e renomeia é:  Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS/GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm

 

________________________

 

Dim lin As Long
    lin = 3
Dim nomeArq As Long
    nomeArq = Range("B" & lin)
      
Do While Not IsEmpty(Range("A" & lin))
    Windows("GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm").Activate
    Sheets("CONTRATOS").Select
    Range("A" & lin).Select
    Selection.Copy
    Windows("CONTRATO.xlsb").Activate
    Range("I1:K1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS\" & nomeArq, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
         
     lin = lin + 1
      Windows("GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm").Activate
               Loop
       End Sub

________________________

[osvaldomp 1.730]

23 horas atrás, Scheila Dayane disse:

A planilha O arquivo onde consta o modelo contrato é:  Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS/CONTRATO.xlsb ~~~> faltou você informar o nome da planilha (que você trata por aba) que contém o modelo do contrato; no código abaixo coloquei NomeDaPlanilha, então substitua pelo nome correto

 

Sub GravaPDFs()
 Dim lin As Long, nomeArq As String, wsO As Worksheet, wsD As Worksheet
  Set wsO = Workbooks("GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm").Sheets("CONTRATOS")
  Set wsD = Workbooks("CONTRATO.xlsb").Sheets("NomeDaPlanilha") '<< coloque o nome da planilha
  With wsO
   For lin = 3 To .Cells(Rows.Count, 1).End(3).Row
    .Cells(lin, "A").Copy wsD.Range("I1:K1")
    nomeArq = .Cells(lin, "B")
    ChDir "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS"
    wsD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS\" & nomeArq, Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   Next lin
  End With
End Sub

 

 

[Scheila Dayane 1]

17 minutos atrás, osvaldomp disse:

Dim lin As Long, nomeArq As String, wsO As Worksheet, wsD As Worksheet Set wsO = Workbooks("GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm").Sheets("CONTRATOS") Set wsD = Workbooks("CONTRATO.xlsb").Sheets("NomeDaPlanilha") '<< coloque o nome da planilha With wsO For lin = 3 To .Cells(Rows.Count, 1).End(3).Row .Cells(lin, "A").Copy wsD.Range("I1:K1") .nomeArq = .Cells(lin, "B") ChDir "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS" wsD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS\" & nomeArq, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

 

55 minutos atrás, osvaldomp disse:

Obrigada, Funcionou, mais está copiando da planilha errada

Está parte esta mandando copiar da wsD e preciso que copie da wsO e cole na Range("I1") da planilha wsD.

 

Troquei mais não funcionou.

 

  For lin = 3 To .Cells(Rows.Count, 1).End(3).Row
    Cells(lin, "A").Copy wsD.Range("I1")
     nomeArq = .Cells(lin, "B")

 

    Set wsO = Workbooks("GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm").Sheets("CONTRATOS")
    Set wsD = Workbooks("CONTRATO.xlsb").Sheets("COMODATO")

 

 

55 minutos atrás, osvaldomp disse:

Sub GravaPDFs()
 Dim lin As Long, nomeArq As String, wsO As Worksheet, wsD As Worksheet
  Set wsO = Workbooks("GERENCIAL COOLERS PLACEMENT AT POS_OFF PREMISE.xlsm").Sheets("CONTRATOS")
  Set wsD = Workbooks("CONTRATO.xlsb").Sheets("NomeDaPlanilha") '<< coloque o nome da planilha
  With wsO
   For lin = 3 To .Cells(Rows.Count, 1).End(3).Row
    .Cells(lin, "A").Copy wsD.Range("I1:K1")
    .nomeArq = .Cells(lin, "B")
    ChDir "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS"
    wsD.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     "Z:\PROMOCIONAL\PROMOCIONAL CONTRATOS\CONTRATOS\" & nomeArq, Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   Next lin
  End With
End Sub

 

 

 

[osvaldomp 1.730]

2 horas atrás, Scheila Dayane disse:

Obrigada, Funcionou, mais está copiando da planilha errada

Está parte esta mandando copiar da wsD e preciso que copie da wsO e cole na Range("I1") da planilha wsD.

 

 

Se você se refere ao comando .Cells(lin, "A").Copy wsD.Range("I1:K1") então não procede o seu comentário, pois o comando copia de wsO e cola em wsD.

 

Disponibilize uma amostra dos dois arquivos Excel e coloque na planilha o resultado desejado com as explicações.

 

dica - para responder clique diretamente na caixa Responder, abaixo da última postagem, só clique em Citar se necessário.

[Scheila Dayane 1]

Osvaldo,

 

Envio em anexo o detalhe de cada planilha. 
A planilha wsD gera os pdfs  com base na informação da planilha wsO na aba "CONTRATOS".
Preciso que a Range ("i1") da planilha wsD seja preenchida com a informação da cél ("A3") da planilha wsO em loop.

Consegue entender? Pois agora tá pegando a cél ("A3") da planilha wsD e fazendo loop.

 

o

[osvaldomp 1.730]

1 hora atrás, osvaldomp disse:

Disponibilize uma amostra dos dois arquivos Excel e coloque na planilha o resultado desejado com as explicações.

 

 

É preciso disponibilizar os arquivos Excel, imagens não servem.

Disponibilize com o código que eu passei instalado.

 

obs. arquivos com macros devem ser compactados para serem aceitos aqui no fórum

[mick 07 2.628]

@Scheila Dayane dúvida movida para um tópico próprio.

[Scheila Dayane 1]

Osvaldo, Bom dia!

Grata pela ajuda.

Disponibilizo os arquivos em "teste", alterei na macro o nome para que funcione.

Veja os exemplos que destaquei nas setas "vermelhas" nas planilhas.

teste.zip

[osvaldomp 1.730]

Olá, Scheila.

 

O problema ocorre porque você removeu o ponto inicial do comando que citei no post #4.

Recoloque o ponto conforme destacado em vermelho abaixo.

  .Cells(lin, "A").Copy wsD.Range("I1")

[Scheila Dayane 1]

2 horas atrás, osvaldomp disse:

Olá, Scheila.

 

O problema ocorre porque você removeu o ponto inicial do comando que citei no post #4.

Recoloque o ponto conforme destacado em vermelho abaixo.

  .Cells(lin, "A").Copy wsD.Range("I1")

Obrigada Osvaldo, agora deu certo, um "ponto" faz uma grande diferença.
Valeu pela força, me adiantou muito o trabalho.

[Patropi 2.662]

@Scheila Dayane

 

Você se esqueceu de clicar em Curtir nas respostas do Osvaldo.

Como a dúvida foi sanada, marque também a última resposta dele como Resolvido.

Na minha assinatura tem um link para uma instrução de como proceder.

 

[]s