Excel mudar conteudo para baixo quando chegar determinada data

[alexassa]

Obrigado pessoal.

mais uma duvida.

tenho uma lista de funcionários e gostaria de organizar ela tipo. conforme um funcionário pede demissão eu colocaria a data da demissão e quando chegar esta data automaticamente ir para baixo da lista.

[alexassa]

Salve Galera... Alguma Ideia??

[Visitante]

 

Disponibilize o seu arquivo Excel com exemplos. Imagens não servem.

[alexassa]

@osvaldomp  aqui esta, uma luz por favor

saida.xlsx

[Visitante]

 

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

Private Sub Workbook_Open()
 Dim k As Long
  With Sheets("Sheet1")
   For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1
    If .Cells(k, 4) <> "" And .Cells(k, 4) <= Date Then
     .Cells(k, 2).Resize(, 3).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, 3).Delete
    End If
   Next k
  End With
End Sub

Para testar salve o arquivo habilitado para macros, feche e reabra.

[alexassa]

@osvaldomp cara tentei salvar o código ,,mas da um erro e nao salva,, meu pc esta em japonês e nao sei qual e o erro,,

parece que ele pede o arquivo que tem a macro...

[Visitante]

Sim, isso foi o que comentei no post #5 ~~~> "Para testar salve o arquivo habilitado para macros, feche e reabra."

[alexassa]

@osvaldomp deu certo,, tive que fazer um arquivo novo.

como faço para ele mudar todas as informação que estiver na coluna?

 

[Visitante]

4 minutos atrás, alexassa disse:

 

como faço para ele mudar todas as informação que estiver na coluna?

 

 

É facinho.

Basta você dizer a ele "de onde tirar" e "para onde levar" as informações que você quer mudar.

[alexassa]

@osvaldomp KKKKKKKKKKKKKKKKKK

nao deu certo hauhauaha

saida.xlsx

[alexassa]

@osvaldomp da uma ajuda... tentei mudar o código mas da erro ...:(

[Visitante]

 

Em 06/04/2020 às 22:29, alexassa disse:

 

como faço para ele mudar todas as informação que estiver na coluna?

 

 

Com base no que você escreveu aí acima eu não consigo entender o que você quer ...

 

Eu baixei o arquivo do post #10 e também lá não encontrei qualquer explicação do que você quer fazer e nem exemplos do resultado desejado.

[alexassa]

@osvaldomp da uma olhada agora.;

obrigado pelas respostas

saida20200409.xlsx

[Visitante]

2 horas atrás, alexassa disse:

 ...da uma olhada agora.;

 

"quando chegar esta data mover todo o conteudo da cedula para baixo conteudo da cedula futuramente pode aumentar"

 

 

Me parece que o seu tradutor Japonês X Português é xing ling.

O código abaixo é um "chute" pois tenho dificuldade pra entender o que você quer. Testaí ...

 

Instale uma cópia do código abaixo no lugar do anterior. Adicionei um comando que utiliza W1 como célula auxiliar para evitar que o código rode sem necessidade se for aberto mais de uma vez no mesmo dia. Então, após testar o código remova o apóstrofo inicial da terceira linha do código para ativar aquele comando.

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("Sheet1")
   For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1
    If .Cells(k, 4) <> "" And .Cells(k, 4) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

 

[alexassa]

@osvaldomp Obrigado, ficou perfeito

 

adicionado 26 minutos depois

@osvaldomp Cara, deu e nao deu certo kkkkk

tentei mexer no código mas nao deu certo,, nao entendo nada kkkkk

este arquivo seria o completo com informação dentro, se puder me ajudar,Obrigado.

Conpleto.xlsx

[alexassa]

Por favor,kkkkk

[Visitante]

 

1 hora atrás, alexassa disse:

Por favor,kkkkk

 

Em 09/04/2020 às 14:07, alexassa disse:

adicionado 26 minutos depois

@osvaldomp Cara, deu e nao deu certo kkkkk

 

 

eu não tinha visto que você editou a mensagem do post #15 ... kkkkk

no arquivo do post #15 não encontrei qualquer código ... kkkkkk

qual foi o código que "fez que deu mas não deu" ?  ... kkkkkk

 

E informe com exatidão qual foi o resultado ao abrir o arquivo e qual é o resultado desejado.

[alexassa]

@osvaldomp

este aqui que você mandou.

 

Em 09/04/2020 às 12:01, osvaldomp disse:

 

 

 

Instale uma cópia do código abaixo no lugar do anterior. Adicionei um comando que utiliza W1 como célula auxiliar para evitar que o código rode sem necessidade se for aberto mais de uma vez no mesmo dia. Então, após testar o código remova o apóstrofo inicial da terceira linha do código para ativar aquele comando.

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("Sheet1")
   For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1
    If .Cells(k, 4) <> "" And .Cells(k, 4) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

usei este aqui

 

[Visitante]

56 minutos atrás, osvaldomp disse:

E informe com exatidão qual foi o resultado ao abrir o arquivo e qual é o resultado desejado.

 

 

Você leu ?

[alexassa]

 

Em 10/04/2020 às 00:01, osvaldomp disse:

 

 

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("在留確認")
   For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1
    If .Cells(k, 5) <> "" And .Cells(k, 5) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

 

 

estou usando este código.

como a imagem que estou mandando ele nao mudo todo o conteúdo para baixo.

Completo.xlsx

[alexassa]

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("在留確認")
   For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1
    If .Cells(k, 5) <> "" And .Cells(k, 5) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

estou usando este código.

como a imagem que estou mandando ele nao mudo todo o conteúdo para baixo.

Completo.xlsx

[alexassa]

estou tentando postar mas esta ficando oculto o post, porque será?

adicionado 1 minuto depois

estou usando este código.

como a imagem que estou mandando ele nao mudo todo o conteúdo para baixo.

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("在留確認")
   For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1
    If .Cells(k, 5) <> "" And .Cells(k, 5) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

 

[Visitante]

 

Nos arquivos anteriores a data a ser buscada estava na coluna D, porém nesse último arquivo você colocou uma observação na planilha (figura abaixo) que é para buscar na coluna E, é isso? Se sim, então altere conforme em vermelho abaixo.

For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1 ~~~> busca a data na coluna D

For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1 ~~~> busca a data na coluna E

 

Sobre deixar linhas vazias eu não sei fazer, sorry. Você pode inserir as linhas manualmente onde desejar.

 

[alexassa]

@osvaldomp sim eu mudei no código de 4 para 5 mas nao deu certo.nao seu se viu a foto que postei aqui,, nao esta movendo tudo para baixo.

[Visitante]

Pelas fotos eu não consegui entender.

Conforme eu pedi antes, explique com exatidão o resultado do código e o resultado desejado, coloque as duas situações e as explicações e publique a planilha ao invés das fotos.