Notifications
Clear all

Buscar em Plan1 e mover linha para Plan2

14 Posts
3 Usuários
0 Reactions
1,734 Visualizações
(@soniccrazy)
Posts: 6
Active Member
Topic starter
 

Boa tarde.
Galera, preciso de uma ajuda com um script em VBA, que funcione de tal forma:

Buscar em Plan1, na coluna J a palavra "Sim" e mover desta linha os valores das colunas A,B,C,D,E,F,G,H,I.
e ao mover para a Plan2, na coluna J deve-se informar a data atual (date()) e na coluna K o valor "Não"
Além de mover, teria que organizar a plan1 para que não fique "furos" entre os registros.

Poderiam me ajudar?
Agradeço desde já.

 
Postado : 10/08/2015 2:14 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Veja;
http://www.google.com.br/cse?cx=partner ... gsc.page=1

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/08/2015 5:57 am
(@soniccrazy)
Posts: 6
Active Member
Topic starter
 

Bom dia!!

Veja;
http://www.google.com.br/cse?cx=partner ... gsc.page=1

Att

Bom dia!
Alexandre, esse topico viewtopic.php?t=10502&p=55446 seria praticamente oque eu estava procurando, porém ao invés de mover a coluna seria a linha.
O problema, é que o o arquivo .zip fornecido está corrompido, não consigo abrir...

Poderia me ajudar?

 
Postado : 11/08/2015 7:51 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Poste seu arquivo!

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/08/2015 8:55 am
(@soniccrazy)
Posts: 6
Active Member
Topic starter
 

Segue arquivo em anexo.
A ideia seria que, ao clicar em EXPEDIR, a macro faria a verificação na coluna J oque foi marcado como "Sim" e movia o registro para a Plan2, com as informações de algumas colunas e modificar outras.
Minha dificuldade é qual parâmetro usar para fazer esta busca, e selecionar a row a ser movida...
Obrigado pela atenção!

 
Postado : 11/08/2015 9:05 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Veja se ajuda.

Sub AleVBA_16941()
    Range("A6").AutoFilter 10, "=Sim"
    Range("A1", Range("J65536").End(xlUp)).Copy Worksheets("Expedidas").[A1]
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/08/2015 2:42 pm
(@soniccrazy)
Posts: 6
Active Member
Topic starter
 

Boa tarde!!

Veja se ajuda.

Sub AleVBA_16941()
    Range("A6").AutoFilter 10, "=Sim"
    Range("A1", Range("J65536").End(xlUp)).Copy Worksheets("Expedidas").[A1]
End Sub

Gerou a seguinte mensagem de erro, ao executar a macro:

"Erro em tempo de execução '1004':
O metodo AutoFilter da classe range falhou."

 
Postado : 11/08/2015 2:47 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Veja se ajuda.

Sub AleVBA_16941()
    Range("A6").AutoFilter 10, "=Sim"
    Range("A1", Range("J65536").End(xlUp)).Copy Worksheets("Expedidas").[A1]
End Sub

Gerou a seguinte mensagem de erro, ao executar a macro:

"Erro em tempo de execução '1004':
O metodo AutoFilter da classe range falhou."

Acrescente antes de : Range("A6").AutoFilter 10, "=Sim" a instrução : AutoFilterMode = False ficando :

Sub AleVBA_16941()
AutoFilterMode = False
    Range("A6").AutoFilter 10, "=Sim"
    Range("A1", Range("J65536").End(xlUp)).Copy Worksheets("Expedidas").[A1]
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 12/08/2015 9:14 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Eu não tive problemas!!

Caso não conseguir, fale que eu posto seu arquivo adaptado!

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 12/08/2015 9:55 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Eu não tive problemas!!
Caso não conseguir, fale que eu posto seu arquivo adaptado!
Att

Alexandre, o erro se dá devido ao modelo que esta anexado estar com a opção filtro definida nas colunas de "A até I" e a rotina está filtrando pela coluna "J", então se antes de executar a rotina limpar o filtro não teremos erro.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 12/08/2015 10:26 am
(@soniccrazy)
Posts: 6
Active Member
Topic starter
 

Boa noite.
Galera, até consegui rodar a Macro, porém ele copia os dados da Plan1 para Plan2 e não apaga da Plan1.
Outra situação por exemplo, é que se a linha 1, 5 e 7 estiverem no critério "Sim" da Macro, apesar do filtro, ele copia todas as linhas da 1 á 7(Onde deveria copiar somente as do critério "Sim" da Coluna J) mantendo as linhas 2,3,4,6 ocultas...

Alguem pode me ajudar nesta situação?
Agradeço desde já.

 
Postado : 10/09/2015 3:19 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Conforme postagem em:
http://gurudoexcel.com/forum/viewtopic. ... c1c1552a0d

Option Explicit

Sub AleVBA_573V3()
Dim wsDest As Worksheet, wsOrg As Worksheet
Dim Lr As Long

Set wsOrg = ThisWorkbook.Worksheets("Patio")
Set wsDest = ThisWorkbook.Worksheets("Expedidas")
Application.ScreenUpdating = 0
    'wsDest.Range("A7:K5000").ClearContents
    With wsOrg.Range("A6").CurrentRegion
        Lr = wsDest.Cells(Rows.Count, "J").End(xlUp).Row
        .AutoFilter field:=10, Criteria1:="Sim" 'Pega o valor da coluna J na guia Patio
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Destination:=wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
        .AutoFilter
    
        With wsDest
            Lr2 = .Cells(Rows.Count, "J").End(xlUp).Row
            .Range("K7").Value = Date
            .Range("L7").Value = "Não"
        End With
    End With
    wsDest.Activate
    wsDest.Range("K7:L7").AutoFill Destination:=Range("K7:L" & Lr2), Type:=xlFillDefault
    wsOrg.Select
Application.ScreenUpdating = 1
End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/09/2015 2:42 pm
(@mprudencio)
Posts: 2749
Famed Member
 

Experiemente colar esse codigo em um modulo ou botao active x

Sub Expedição()

Application.ScreenUpdating = False

Sheets("Patio").Select

Range("J7").Select

Do While ActiveCell <> ""

If ActiveCell.Value = "Sim" Then

Intersect(Selection.EntireRow, Range("A:I")).Select
Selection.Copy
Sheets("Expedidas").Select
Range("A1048576").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 9).Select
ActiveCell.Value = Date
Range("A7").Select
Sheets("Patio").Select
ActiveCell.EntireRow.Delete
ActiveCell.Offset(0, 9).Select

Else

ActiveCell.Offset(1, 0).Select

End If

Loop
Range("A7").Select

MsgBox "Expedição Realizada Com Sucesso", vbOKOnly, "Atenção"

Application.ScreenUpdating = True

End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 12/09/2015 11:00 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Solução proposta em:
http://gurudoexcel.com/forum/viewtopic. ... f11d61ff3c

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 25/09/2015 2:05 pm