Este fórum está sendo desativado

[lcbispo]

Bom dia Pessoal,

Estou precisando de uma ajudinha! Como vocês são feras... não terão problema em fazer uma vba, conforme planilha em anexo.

Grato pela ajuda de todos....

[RCA]

Sub Demitido()

dim ultLinha as integer, linha as integer

ultLinha = Sheets("Cad1").Range("C1048576").end(xlup).row
for linha = 10 to ultLinha
if sheets("Cad1").range("I" & linha).value = "Demitido" then
Worksheets("Cad1").range("C" & linha & ":I" & linha).copy Worksheets("Cad2").range("C" & linha & ":I" & linha)
end if

End sub

Sou apenas um curioso em VBA, as acho que esse código pode resolver teu problema.

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub ReplicaDemitidos()
  Application.ScreenUpdating = False
  Sheets("Cad2").Cells = ""
   On Error Resume Next
   ActiveSheet.ShowAllData
   On Error GoTo 0
   [C9:I9].AutoFilter 7, "DEMITIDO"
   If ActiveSheet.AutoFilter.Range.Columns(9).SpecialCells(12).Count > 1 Then
     Range("C9:I" & Cells(Rows.Count, 3).End(3).Row).Copy Sheets("Cad2").[A1]
   End If
   ActiveSheet.ShowAllData
End Sub

[lcbispo]

RCA, erro for sem next.

[lcbispo]

Osvaldomp, tem como copiar e colar na planilha cad2 e excluir da planilha cad1

[osvaldomp]

Osvaldomp, tem como copiar e colar na planilha cad2 e excluir da planilha cad1
Sim, veja abaixo. Porém isso vai provocar erro nas fórmulas da coluna C.

Acrescente a linha em vermelho conforme abaixo.
Range("C9:I" & Cells(Rows.Count, 3).End(3).Row).Copy Sheets("Cad2").[A1]
Range("C10:I" & Cells(Rows.Count, 3).End(3).Row).EntireRow.Delete
End If

[lcbispo]

Osvaldo, uma duvida:
- Quando eu faço a exclusão , o codigo deleta todas as informações da planilha cad2 e deixa a ultima informação. Teria que ficar todas as informações.

[osvaldomp]

Utilize este abaixo no lugar do anterior.
Inicialmente coloque na Cad2 somente os cabeçalhos na linha 1, a partir de A1.

Código: Selecionar todos

Sub ReplicaDemitidos()
  Application.ScreenUpdating = False
   On Error Resume Next
   ActiveSheet.ShowAllData
   On Error GoTo 0
   [C9:I9].AutoFilter 7, "DEMITIDO"
   If ActiveSheet.AutoFilter.Range.Columns(9).SpecialCells(12).Count > 1 Then
    Range("C10:I" & Cells(Rows.Count, 3).End(3).Row).Copy Sheets("Cad2").Cells(Rows.Count, 1).End(3)(2)
    Range("C10:I" & Cells(Rows.Count, 3).End(3).Row).EntireRow.Delete
   End If
   ActiveSheet.ShowAllData
End Sub

[lcbispo]

Osvaldo, Bom dia meu amigo!
Quando faço a exclusão pela primeira vez para a planilha cad2 vai sem formula, até ai perfeito! mas quando lanço uma nova demissão e faço a exclusão ele vai com formulas.

[osvaldomp]

Verdade, sorry.

Substitua esta linha

Código: Selecionar todos

Range("C10:I" & Cells(Rows.Count, 3).End(3).Row).Copy Sheets("Cad2").Cells(Rows.Count, 1).End(3)(2)

#
por estas duas

Código: Selecionar todos

Range("C10:I" & Cells(Rows.Count, 3).End(3).Row).Copy
Sheets("Cad2").Cells(Rows.Count, 1).End(3)(2).PasteSpecial xlValues

#
Formate manualmente as colunas D e E da Cad2 como data, se necessário.

[lcbispo]

Osvaldo, Perfeito! esta rodando legal.
Grato pela atenção.