Excel Mover o conteúdo da linha conforme status da célula.

[GENECIOFICIAL]

Boa tarde!

 

Solicito a sua ajuda para elaborar um código vba, que faça o seguinte.

Na planilha1 coluna C, se o status for 1, mover o conteúdo da linha para a Planilha 2, se o status for 0 nada acontece.

Como resposta, as linhas com a cor azul serão movidas.

Novos ítens serão adicionados.

 

Grato - Geneci.

PERG MOVER CONFORME STATUS.xlsx

[OreiaG]

Seguem duas soluções.

 

Este primeiro código deve ser instalado em um módulo comum (exemplos: no Módulo1 ou no Módulo2 ou ...).

Utilize-o no caso de a sua tabela de dados já estiver montada. Funciona com qualquer quantidade de linhas na tabela.

Após executá-lo uma única vez, se necessário, aí passe a utilizar somente o segundo código abaixo.

Sub MoveDados()
 Dim LR As Long
 With Sheets("Planilha1")
  LR = .Cells(Rows.Count, 3).End(3).Row
  .Range("C1:D" & LR).AutoFilter 1, 1
  If .AutoFilter.Range.Columns(3).SpecialCells(12).Count < 2 Then .AutoFilterMode = False: Exit Sub
  .Range("C2:D" & LR).SpecialCells(12).Copy Sheets("Planilha2").Cells(Rows.Count, 3).End(3)(2)
  .Range("C2:D" & LR).SpecialCells(12).Value = ""
  .AutoFilterMode = False
  .Range("C2:D" & LR).SpecialCells(4).Delete Shift:=xlUp
 End With
End Sub

 

 

Este segundo código deve ser instalado no módulo da Planilha1 e moverá os dados, conforme o critério, assim que eles forem inseridos por digitação ou via Copiar/Colar.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column < 3 Or Target.Column > 4 Or Application.CountA(Cells(Target.Row, "C").Resize(, 2)) < 2 Or Cells(Target.Row, "C") <> 1 Then Exit Sub
 Cells(Target.Row, "C").Resize(, 2).Copy Sheets("Planilha2").Cells(Rows.Count, 3).End(3)(2)
 Cells(Target.Row, "C").Resize(, 2) = ""
 Cells(Target.Row, "C").Resize(, 2).Delete Shift:=xlUp
End Sub

 

[GENECIOFICIAL]

Bom dia!

Dois códigos diferentes para o mesmo resultado.

Os magos do excel e VBA sabem explicar.

 

Os códigos funcionaram.

 

Grato - Geneci.