Ir ao conteúdo

Excel Excel - Macro para salvar planilhas


Ir à solução Resolvido por Visitante,

Posts recomendados

Postado

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

________________________

Postado
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

 

 

Postado
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

 

 

 

Postado
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.

Postado

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.

 

1083397180_PlanilhawsO.thumb.JPG.b11aef668b7b3be923cc4d863c4d5ffd.JPGo

Planilha wsD.JPG

Postado
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

  • Solução
Postado

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")

Postado
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.

  • Membro VIP
Postado

@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

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!