Excel Cópia Condicional de Células para outra planilha

[crownics]

Boa tarde!

 

Estou precisando de uma ajudinha para execução de um macro. 

Tenho uma planilha onde eu relaciono em uma coluna Atividades a serem executadas através de um número (Ordem de Serviço), e coloco em outra coluna (Coluna Responsável) pessoa ou setor responsável para execução desta Atividade. Gostaria que, quando eu colocasse o Responsável como "Compras", fosse copiado o número da atividade para a planilha "Relação de Compras". Necessito que seja um macro, pois se for por fórmula, assim que o responsável deixar de ser "Compras", o registro sumirá da planilha "Relação de Compras".

 

Se possível, também gostaria de outro macro que, se houver um número de Atividade escrita na planilha "Relação de Compras", e o campo "nº da SC" da mesma planilha estiver vazio, não fosse capaz de fechar a planilha.

 

 

A planilha esta em anexo.

 

Desde já, agradeço.

 

Cronograma de Atividades - Ronda Próativa.xls

[crownics]

up

[Visitante]

Em 06/06/2019 às 12:32, crownics disse:

 ...fosse copiado o número da atividade para a planilha "Relação de Compras".

Não encontrei planilha com esse nome O código abaixo replica o número da Atividade na planilha "Compras". Serve?

 

 ... "nº da SC" da mesma planilha estiver vazio, não fosse capaz de fechar a planilha.

O que você quer dizer com "fechar a planilha" ? Seria fechar o arquivo Excel ?

 

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Target.Column <> 7 Or Target.Value <> "Compras" Then Exit Sub
 Sheets("Compras").Cells(Rows.Count, 1).End(3)(2) = Cells(Target.Row, 2)
End Sub

 

[crownics]

3 minutos atrás, osvaldomp disse:

 

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Target.Column <> 7 Or Target.Value <> "Compras" Then Exit Sub
 Sheets("Compras").Cells(Rows.Count, 1).End(3)(2) = Cells(Target.Row, 2)
End Sub

 

Opa. Peço desculpas por ter confundido o nome das planilhas, felizmente você considerou a planilha correta. 

 

Sobre fechar a planilha... Sim, encerrar o Excel. 

[Visitante]

Instale uma cópia do código abaixo no módulo de EstaPasta_de_trabalho.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim at As Range
  With Sheets("Compras")
   For Each at In .Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row)
    If at.Value <> "" And at.Offset(, 1).Value = "" Then
     .Activate: at.Offset(, 1).Select
     MsgBox "PREENCHA nº SC" & vbLf & "O ARQUIVO NÃO SERÁ SALVO"
     Cancel = True: Exit Sub
    End If
   Next at
  End With
End Sub

funcionamento - se na coluna A de Compras houver conteúdo e na coluna B, mesma linha, não, então o código irá ativar Compras, selecionar a célula vazia, exibirá mensagem de alerta e não fechará o arquivo.

 

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

[crownics]

16 horas atrás, osvaldomp disse:

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim at As Range With Sheets("Compras") For Each at In .Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row) If at.Value <> "" And at.Offset(, 1).Value = "" Then .Activate: at.Offset(, 1).Select MsgBox "PREENCHA nº SC" & vbLf & "O ARQUIVO NÃO SERÁ SALVO" Cancel = True: Exit Sub End If Next at End With End Sub

Opa, beleza?

 

Então, estava testando o código, e ao clicar fechar ele imprime a msg na tela, porém se insistir em clicar para fechar (especificamente após ter sido impresso a mensagem)a planilha é fechada sem salvar, porém, não gostaria nem que a mesma fosse fechada.

 

Tentei modificar um pouco o código com este que tenho, porém não consigo.

Citação

Private Sub Workbook_BeforeClose(Cancel As Boolean) With Sheets("Plan1")

 If .[A1] = "Pendente" And .[B1] = ""

Then MsgBox "preencha 'B1'"

Sheets("Plan1").Activate Cancel = True

End If

End With

End Sub

 

Seria pedir muito para me ajudar com este unico detalhe?

 

Atenciosamente.

 

[Visitante]

O arquivo anexo contém uma cópia instalada do código que passei e funciona exatamente como descrevi no post #5.

 

Não Fecha.zip

[crownics]

2 horas atrás, osvaldomp disse:

O arquivo anexo contém uma cópia instalada do código que passei e funciona exatamente como descrevi no post #5.

 

Acabei de testar, mas ainda continua o que disse. Eu clico para fehar uma vez, o erro é impresso na tela, eu fecho o alerta e tento fechar novamente e consigo. Será que pode ser erro de meu excel?

[Visitante]

Estranho.

Vamos pedir ao Mestre @Patropi a gentileza de testar o arquivo do post #7 e tentar fechá-lo sem preencher B3:B4 da planilha Compras.

 

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

[Patropi]

@osvaldomp

 

Eu baixei o arquivo, quando tentei fechar retornou o aviso que o arquivo não será fechado.... , mas dei OK e tentei fechar novamente e ele fechou.

[Visitante]

Valeu @Patropi

 

Então me parece que o meu Excel é que está com defeito de fabricação, pois aqui gastei o X de tanto clicar e nunca fecha se não preencher B3:B4

 

@crownics você pode por favor instalar no seu arquivo uma cópia do código que passei no post #5, compactar e disponibilizar aqui no fórum. Não precisa de dados na planilhas, apenas na planilha Compras umas 3 ou 4 linhas para testes. Use o seu arquivo, não use o arquivo que eu postei.

[crownics]

@osvaldomp opa, segue.

 

 

Cronograma.zip

[Visitante]

Testei no seu arquivo e o resultado é igual, ou seja, não fecha.

Notei que a sua versão é .xls.

Como últimas tentativas, experimente cada um dos 3 códigos abaixo no lugar do atual.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim at As Range
  With Sheets("Relação de Compras")
   For Each at In .Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row)
    If at.Value <> "" And at.Offset(, 1).Value = "" Then
     .Activate: at.Offset(, 1).Select
     MsgBox "PREENCHA nº SC" & vbLf & "O ARQUIVO NÃO SERÁ FECHADO"
     Cancel = True
    End If
   Next at
  End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim at As Range
  With Sheets("Relação de Compras")
   For Each at In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    If at.Value <> "" And at.Offset(, 1).Value = "" Then
     .Activate: at.Offset(, 1).Select
     MsgBox "PREENCHA nº SC" & vbLf & "O ARQUIVO NÃO SERÁ FECHADO"
     Cancel = True: Exit Sub
    End If
   Next at
  End With
End Sub

 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim at As Range
  With Sheets("Relação de Compras")
   For Each at In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    If at.Value <> "" And at.Offset(, 1).Value = "" Then
     .Activate: at.Offset(, 1).Select
     MsgBox "PREENCHA nº SC" & vbLf & "O ARQUIVO NÃO SERÁ FECHADO"
     Cancel = True
    End If
   Next at
  End With
End Sub

 

[crownics]

@osvaldomp Testei todos, tanto no formado .xls quanto no .xlsm

[Visitante]

  e  

[crownics]

@osvaldomp não funcionou, na primeira vez que tento fechar ele imprime o erro, mas na segunda ele fecha

[Visitante]

Honestamente, não sei como resolver pois eu não consigo reproduzir o erro aqui. peço desculpas.

[Bikke]

Boa noite

 

Saquei a planilha que se encontra no post #12: Cronograma.zip

 

E coloquei os 3 códigos VBA do osvaldomp em EstaPasta_de_trabalho

 

Em todos eles, se eu tentar fechar aparece a Msg para que eu preencha os Campos em B2 e B3, se fizer OK, a planilha não fecha, mas, se eu colocar dados em B2 e B3, e for fechar o Excel, aparece a mensagem a perguntar se deseja guardar as alterações feitas na planilha, e aí já fecha e salva.

Agora, se se tentar fechar a planilha sem Preencher as células B2 e B3, a planilha não fecha, mesmo clicando no OK, a planilha fica sempre em aberto e não sai dali.

Portanto, se o desejo do participante que postou o tópico é se só dá para gravar a planilha após preencher as células B2 e B3, o código VBA do osvaldomp, faz o desejado.

Pelo menos comigo deu, e experimentei todos os códigos postados pelo Mestre osvaldomp no post #13

Espero que tenha sido útil.

 

Cumps

[crownics]

Acho que é erro do meu excel. Ele é 2016 e ainda não está ativo.