Ir ao conteúdo
  • Cadastre-se

Yuri Watzech

Membro Júnior
  • Posts

    4
  • Cadastrado em

  • Última visita

Reputação

0
  1. Boa tarde a todos! Estou com uma dúvida em uma programação VBA. Falta alguns trechos para finalizar o programa, mas eu nao estou conseguindo fazer =/ Alguém poderia me ajudar, por favor? Vamos lá! A lógica que o programa tem que seguir é a seguinte: Selecionar Célula A2 Selecionar Coluna A até o dado da coluna An <diferente> An + 1 Selecionar todos os dados a partir da coluna D até Dn Copiar estes dados Abrir uma nova planilha no formato CSV Colar na célula A2 da nova planilha Selecionar todos os dados a partir da coluna E até En Colar na célula B2 da nova planilha Selecionar todos os dados a partir da coluna F até Fn Colar na célula C2 da nova planilha Selecionar todos os dados a partir da coluna G até Hn Colar na célula D2 da nova planilha Selecionar todos os dados a partir da coluna H até In Colar na célula E2 da nova planilha Selecionar todos os dados a partir da coluna I até Jn Colar na célula F2 da nova planilha Selecionar todos os dados a partir da coluna J até Kn Colar na célula G2 da nova planilha Copiar o dado da célula An Salvar a Planilha Nova como nome da célula An copiada Fechar a Planilha Nova. (loop) Repetir o processo a partir da célula An + 1, e assim por diante (A cada dado diferente da coluna A criar uma nova planilha), até a ultima linha A planillha que fiz, está fazendo o processo de copiar e colar perfeitamente, porém não sei fazer a macro reconhecer a mudança de conteúdo das células (An <> An + 1), assim criando apenas uma planilha copia contendo tudo. Segue planilha em anexo com a VBA e a planilha(vazia) que usei de base para criação. Código: Sub Macro() Workbooks.Open ("C:\Users\yuri.watzech\Desktop\Macro Cut-Over Pedido\Saving CSV Test\Planilha Padrão.xlsx") Worksheets("Plan1").Activate Windows("Macro V2.xlsm").Activate Range("D2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("A2").Select ActiveSheet.Paste Windows("Macro V2.xlsm").Activate Range("E2").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("B2").Select ActiveSheet.Paste Windows("Macro V2.xlsm").Activate Range("F2").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("C2").Select ActiveSheet.Paste Windows("Macro V2.xlsm").Activate Range("G2").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("D2").Select ActiveSheet.Paste Windows("Macro V2.xlsm").Activate Range("H2").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("E2").Select ActiveSheet.Paste Windows("Macro V2.xlsm").Activate Range("I2").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("F2").Select ActiveSheet.Paste Windows("Macro V2.xlsm").Activate Range("J2").Select Range(Selection, Selection.End(xlDown)).Select Application.CutCopyMode = False Selection.Copy Windows("Planilha Padrão.xlsx").Activate Range("G2").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveWorkbook.SaveAs Filename:= _ "C:\Users\yuri.watzech\Desktop\Macro Cut-Over Pedido\Saving CSV Test\" & Cells(ActiveCell.Row, 1) & ".xlsx" _ , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close End Sub Obrigado desde já!!! Macro V2.xlsx Planilha Padrão.xlsx
  2. Tentei tudo isso ai =/ Infelizmente não deu haha No idea kkk tks bro! @olliver.soul
  3. @olliver.soul tentei aqui substituir o código, continuou mandando apenas para o primeiro destinatário....... O código ficou assim: 'Email automático em massa para fornecedores - Autor: Yuri Watzech' Sub Enviar_Email() Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) On Error Resume Next For i = 3 To 6 If Exemplo1.Range("F" & i).Value <> "Ok" Then With OutlookMail .To = Exemplo1.Range("F" & i).Value .CC = Exemplo1.Range("G" & i).Value .BCC = Exemplo1.Range("H" & i).Value .Subject = Exemplo1.Range("E" & i).Value .HTMLBody = Exemplo1.Range("L" & i).Value .Send '.Display 'Use .Send para enviar o email direto sem exibir na tela'' End With End If Next i On Error GoTo 0 Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub =/
  4. Bom dia a todos! Gostaria de tirar uma dúvida e entender o que estou fazendo de errado no meu código. Estou criando uma Macro para enviar emails em massa para destinatários diferentes, cada um com um texto. Meu problema esta sendo que ele esta enviando somente para a primeira linha da planilha, não está repetindo para os demais. Imagino que seja um Loop faltante, mas pelo fato de ter um "Next i", entendo que funcionaria.... Alguém pode me ajudar? Obrigado!!! Obs: São 4 Emails diferentes (4 Linhas) Código: Sub Enviar_Email() Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) On Error Resume Next For i = 1 To 4 If Exemplo1.Range("F" & i + 2).Value <> "Ok" Then With OutlookMail .To = Exemplo1.Range("F" & i + 2).Value .CC = Exemplo1.Range("G" & i + 2).Value .BCC = Exemplo1.Range("H" & i + 2).Value .Subject = Exemplo1.Range("E" & i + 2).Value .HTMLBody = Exemplo1.Range("L" & i + 2).Value .Send '.Display 'Use .Send para enviar o email direto sem exibir na tela'' End With End If Next i On Error GoTo 0 Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub Segue print da planilha: Obrigado desde já!!! =)

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