Este fórum está sendo desativado

[anacletotranstusa]

Alexandre,
Bom dia!
Anexo o modelo que estou tentando aplicar, perceba que simulei vários cadastros do carro 991, ao ser transferido, os valores dos campos "Classificação" e "Data" estão como formulas. Tem como resolver isso? Referente ao erro de execução teria, teria alguma alternativa para evitá-lo?
Desde já agradeço seus auxilio.

[alexandrevba]

Bom dia!!

Tente algo assim.

Código: Selecionar todos

Sub AleVBA_729V3()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range
Application.ScreenUpdating = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("Cadastro")
        With Range("I2:I326")
            .Formula = "=IF(COUNTA(A2:H2)=8,1,IF(AND(B2<>"""",C2<>"""",E2<>"""",OR(F2="""",G2="""",H2="""")),""Erro"",0))"
            .Value = .Value
        End With
        
        .Activate
        .AutoFilterMode = False
        .Range("I2").AutoFilter
        .Range("I2").AutoFilter Field:=9, Criteria1:="#N/D"
        If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count >= 1 Then
            MsgBox "Favor preencher os campos!"
            .AutoFilterMode = False
             Exit Sub
        End If

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Erro", LookIn:=xlValues, lookat:=xlWhole)
            MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"
            Exit Sub
        Else
            .Range("$A$1:$I" & LR).AutoFilter Field:=9, Criteria1:="1"
            .Range("A2:H" & LR).Copy Worksheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .ShowAllData
            '.Range("I2:I326").Value = ""
        End If
    End With
    Worksheets("Dados").Activate
    With Worksheets("Dados")
     'Dim Lastrow As Long
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A2:A" & LR).Formula = "=ROW()-1"
    End With
    Worksheets("Cadastro").Select
    'Call Limpar
    Application.ScreenUpdating = 1
End Sub

Att

[anacletotranstusa]

Bom dia Alexandre,

Alterei o código do botão conforme seu auxilio, com a alteração, agora mesmo que informe uma informação de limpeza completa, me apresenta a mensagem "Favor preencher os campos!". Exemplo anexo.
Grato pela atenção.

[alexandrevba]

Boa tarde!!

Veja se ajuda.

Código: Selecionar todos

Sub AleVBA_729V4()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range
Application.ScreenUpdating = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("Cadastro")
        With Range("I2:I326")
            .Formula = "=IFERROR(IF(COUNTA(A2:H2)=8,1,IF(AND(B2<>"""",C2<>"""",E2<>"""",OR(F2="""",G2="""",H2="""")),""Erro"",0)),""Erro"")"
            .Value = .Value
        End With

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Erro", LookIn:=xlValues, lookat:=xlWhole)
            MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"
            Exit Sub
        Else
            .Range("$A$1:$I" & LR).AutoFilter Field:=9, Criteria1:="1"
            .Range("A2:H" & LR).Copy Worksheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .ShowAllData
            '.Range("I2:I326").Value = ""
        End If
    End With
    Worksheets("Dados").Activate
    With Worksheets("Dados")
     'Dim Lastrow As Long
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A2:A" & LR).Formula = "=ROW()-1"
    End With
    Worksheets("Cadastro").Select
    'Call Limpar
    Application.ScreenUpdating = 1
End Sub

Att

[anacletotranstusa]

Boa Tarde Alexandre,
Editei o código como postado, se deixar sem informação preenchida na aba cadastro e clicar no botão cadastrar ainda apresenta erro "Erro em tempo de execução '91': A variavel do objeto ou variável do bloco 'With' não foi definida.
Outro detalhe: Na aba Dados, perceba que as informações transferidas que contem formulas está sendo transferida com as formulas, observe a coluna "C" (Classificação) e "D" (Data) da aba Dados.
Att.

[alexandrevba]

Boa tarde!!

Mas eu fiz o que pediu os detalhes é questão de adaptar!

Código: Selecionar todos

Sub AleVBA_729V4()
Dim LR As Long
Dim SearchRange As Range
Dim FindRow As Range
Application.ScreenUpdating = 0
    LR = Range("B" & Rows.Count).End(xlUp).Row
    With Worksheets("Cadastro")
        With Range("I2:I326")
            .Formula = "=IFERROR(IF(COUNTA(A2:H2)=8,1,IF(AND(B2<>"""",C2<>"""",E2<>"""",OR(F2="""",G2="""",H2="""")),""Erro"",0)),""Erro"")"
            .Value = .Value
        End With

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") = 1 Then
            Set SearchRange = Range("I2:I326")
            Set FindRow = SearchRange.Find("Erro", LookIn:=xlValues, lookat:=xlWhole)
            MsgBox "favor preencher os campos necessários!" & " Há " & FindRow.Row - 1 & " registro(s) para verificar"
            Exit Sub
        Else
            .Range("$A$1:$I" & LR).AutoFilter Field:=9, Criteria1:="1"
            .Range("A2:H" & LR).Copy Worksheets("Dados").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            .ShowAllData
            '.Range("I2:I326").Value = ""
        End If
    End With
    Worksheets("Dados").Activate
    With Worksheets("Dados")
     'Dim Lastrow As Long
        LR = Range("B" & Rows.Count).End(xlUp).Row
        Range("A2:A" & LR).Formula = "=ROW()-1"
    End With
    Worksheets("Cadastro").Select
    'Call Limpar
    Application.ScreenUpdating = 1
End Sub

Editado, favor verificar o código!!!
Att

[anacletotranstusa]

Creio que você se equivoco no poste. O poste do Filtro já está resolvido.

[alexandrevba]

Boa tarde!!

Altere a linha para:

Código: Selecionar todos

        With Range("I2:I326")
            .Formula = "=IFERROR(IF(COUNTA(A2:H2)=8,1,IF(AND(COUNTA(A2:H2)=0,OR(F2="""",G2="""",H2="""")),""Erro"",""Erro"")),""Erro"")"
            .Value = .Value
        End With

        If WorksheetFunction.Sum(Range("I2:I" & LR)) = 0 Or WorksheetFunction.CountIf(Range("I2:I" & LR), "Erro") > 1 Then

Faça os testes.

Att

[anacletotranstusa]

Alterei o código e veja como ficou, agora, quando informado as informações necessário para um registro apresenta a mensagem "Favor preencher os campos necessário! Há 2 Registro(s) para verificar". Em relação a transferência, teria alguma solução para transferi somente os valores.

[lfgomes]

Boa tarde amigo...

Com base na sua Planilha, fiz uma com a visualização mais limpa e um código mais simples para realizar o cadastro...

Veja se assim pode te ajudar...

[anacletotranstusa]

Boa Tarde lfgomes,
Ficou show de bola.
Porem, na aba Cadastro preciso que conste todos os carros a ser limpo, visto que em média são registrado 160 limpezas de carros, ou seja, nesse caso seria 160 registro um de cada vez. Devido a isso, ficaria mais rápido o cadastro se fosse possível informar somente os veículos limpos e depois clicar no botão cadastrar fazendo a transferência somente dos veículos limpos. Teria como fazer? , cara, muito obrigado pela sua diga, tem como você me auxiliar no desenvolvimento conforme já descrevi acima?

[lfgomes]

Boa tarde amigo...

Veja se agora atende ao que você precisa...

[lfgomes]

Bom dia...

Estive trabalhando um pouco mais nessa Planilha e acho que consegui melhora-la um pouquinho mais...

Teste as duas e veja se alguma lhe serve...

Abraço...

[anacletotranstusa]

Bom dia lfgomes,
Muito obrigado ficou show de bola, as duas opções já me atenderia.
A segunda opção ficou melhor, estarei implantando, porem, preciso incluir uma formula no campo Data e algumas validações de dados nos campos: Colaborador, Tipo_Lavação, Turno, Responsável, evitando que o usuário informe dados erroneamente (Modelo Anexo), quando clicado no botão cadastrar faz a transferências para a "aba Dados" com a informação do campo data como formula e todos os campos com validação de dado também é transferido com a validação de dados, precisaria que seja transferido somente os valores.
Cara, se puder me auxiliar estaria concluindo a planilha perfeita para minha necessidade.
Cara, agradeço muito sua atenção.

[lfgomes]

Bom dia...

Veja se agora está funcionando do jeito que você quer...

[anacletotranstusa]

Muito bom!
Só para encerrar, preciso também limpar a informação da Célula "L1", sei que é no código abaixo, porem não consegui.
Range("D2:G" & Range("I1").Value).Select
Selection.ClearContents

[lfgomes]

Prontinho...

Terminado...

Espero que esteja do jeito que você quer...

[anacletotranstusa]

Resolvido!!!Maravilha! Agradeço muito ...muito mesmo, a você, ao Alexandre e Henrique, que de alguma maneira tentaram me auxiliar no desenvolvimento desta planilha. Fico sem palavra para demonstrar minha gratidão.
Abraço!