Este fórum está sendo desativado

[GENECI]

Bom dia.

O Sr. Osvaldo atentamente desenvolveu o código VBA, para resolver um problema anterior.

Solicito a sua ajuda, para alterar o código de acordo com explicação no arquivo anexo.

Grato - Geneci.

[osvaldomp]

Olá, Geneci.

Veja se ajuda. Instale os códigos abaixo conforme indicado na primeira linha.

Código: Selecionar todos

'módulo da Planilha1 em substituição ao código atual
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Intersect([C1:C1000], Target) Is Nothing Or Target.Value <> 0 Then Exit Sub
 Target.Resize(, 19).Cut Sheets("destino").Cells(Target.Row, 3)
 Sheets("destino").Cells(Target.Row, 4) = Date
End Sub

Código: Selecionar todos

'módulo da planilha destino
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Intersect([C1:C1000], Target) Is Nothing Or Target.Value <> 0 Then Exit Sub
 Target.Resize(, 19).Cut Sheets("Planilha1").Cells(Target.Row, 3)
 Sheets("Planilha1").Cells(Target.Row, 4) = Date
End Sub

Esta parte ~~~> " ... com a data da célula coluna D, alterada sempre para o mês atual." ~~~> considerei a data do dia, no entanto se você quiser alterar somente o mês então informe, por exemplo, se a data que estiver na planilha destino for 15/08/20 qual será a data ao colar na Planilha1.

[GENECI]

Bom dia, Osvaldo.

Muito obrigado por atender a minha solicitação.

Não me fiz entender, é praticamente isso.

A data da planilha1 movida para a planilha Destino permanece.
Na planilha Destino quando mover a linha para a planilha1, substituir a data pela data do sistema.
E reorganizar as duas planilhas.

Grato - Geneci.

[osvaldomp]

A data da planilha1 movida para a planilha Destino permanece.
Ok, por favor, remova este comando do primeiro código ~~~> Sheets("destino").Cells(Target.Row, 4) = Date

Na planilha Destino quando mover a linha para a planilha1, substituir a data pela data do sistema.
Ok, o código que passei faz isso.

E reorganizar as duas planilhas.
O que você quer dizer com "reorganizar" ?

[GENECI]

'módulo da Planilha1 em substituição ao código atual
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect([C1:C1000], Target) Is Nothing Or Target.Value <> 0 Then Exit Sub
Target.Resize(, 19).Cut Sheets("destino").Cells(Target.Row, 3)
End Sub

O código acima funcionou.
Reorganizar é mover desde a linha excluída, ficando ambas as planilhas com aspecto limpo.

Exemplo desorganizado.
XXXXXXX

XXXXXXX
XXXXXXX


Exemplo organizado.
XXXXXXX
XXXXXXX
XXXXXXX

Grato - Geneci.

[osvaldomp]

Olá, Geneci.
Substitua os códigos anteriores por estes abaixo.

Código: Selecionar todos

'módulo da Planilha1
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim v As Long
  If Target.Count > 1 Then Exit Sub
  If Intersect([C1:C1000], Target) Is Nothing Or Target.Value <> 0 Then Exit Sub
  Target.Resize(, 19).Cut Sheets("destino").Cells(Target.Row, 3)
  For v = Cells(Rows.Count, 4).End(3).Row - 1 To 1 Step -1
   If Cells(v, 4) = "" Then Rows(v).Delete
  Next v
  With Sheets("destino")
   For v = .Cells(Rows.Count, 4).End(3).Row - 1 To 1 Step -1
    If .Cells(v, 4) = "" Then .Rows(v).Delete
   Next v
  End With
End Sub

Código: Selecionar todos

'módulo da planilha destino
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim v As Long
  If Target.Count > 1 Then Exit Sub
  If Intersect([C1:C1000], Target) Is Nothing Or Target.Value <> 0 Then Exit Sub
  Target.Resize(, 19).Cut Sheets("Planilha1").Cells(Target.Row, 3)
  Sheets("Planilha1").Cells(Target.Row, 4) = Date
  For v = Cells(Rows.Count, 4).End(3).Row - 1 To 1 Step -1
   If Cells(v, 4) = "" Then Rows(v).Delete
  Next v
  With Sheets("Planilha1")
   For v = .Cells(Rows.Count, 4).End(3).Row - 1 To 1 Step -1
    If .Cells(v, 4) = "" Then .Rows(v).Delete
   Next v
  End With
End Sub