Boa tarde a todos

Pesquisando no fórum encontrei alguns códigos e consegui (Tentei) criar uma macro para executar a tarefa No 1, porém tem alguma coisa estranha.
Só é copiado o critério GRANDE e não copia os critérios PEQUENO e MEDIO também não pula uma linha para baixo depois de copiar para que seja copiado os dados do dia seguinte.
Inserir a data na coluna H eu não consegui fazer também a macro para tarefa No 2

Se possível algum mestre deste fórum pode dar uma força?

Estou anexando novamente meu arquivo.

Abraços.

Boa noite:)

Será que alguém teria algum código para que eu possa adaptar a minha plan.

Desde já agradeço.

Abraços

Boa noite!!

Eu fiz só a primeira parte.
http://www.4shared.com/office/WM7VSTlyb ... 10669.html

1- Copiar os dados que estão na plan COLAR DADOS e colar na Plan DATA BASE porém necessito que seja copiado apenas as linhas onde constam as informações PEQUENO, MÉDIO e GRANDE e depois inserir a data do dia na coluna H.
Lembrando que essa tarefa vai ser diária então necessito que após copiar as informações sempre pule uma linha pra baixo(Ultima linha em branco) para não haver problema quando for efetuar a colagem dos dados no dia seguinte.

Att

Bom dia caro colega alexandrevba

Muito obrigado por me ajudar!
Você não sabe como esta sendo útil sua ajuda.
Então testei o macro que você fez e funciona bem, porém não era bem isso que precisava.
A plan DATA BASE vou usar como banco de dados então preciso que todos dados copiados da plan COLAR DADOS fique gravado na plan DATA BASE e seja inserido a data que foi copiado na coluna H.
Efetuei alguns testes e percebi que quando e feito a copia dos dados na segunda vez que se chama a macro ela nao copia a informação do critério PEQUENO.
Por que será que acontece isso??
Desculpe pelo incomodo e espero que tenha a resposta para meu problema.

Desde já agradeço

Abraços.

Boa tarde!!

Me desculpa quanto a data, eu acabei me esquecendo.

Quanto ao erro, eu não tive tal problema, mas teste a rotina abaixo.

Sub Copiar_AleVBA_10669()
    Dim lRow As Long
    Application.ScreenUpdating = False
    With Plan2
        .AutoFilterMode = False
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A5:G" & lRow).AutoFilter Field:=1, Criteria1:="<>"
        .Range("A5:G" & lRow).Copy Destination:=Plan3.Range("A" & Rows.Count).End(xlUp).Offset(0)
        .Range("A5").AutoFilter
    End With
    With Sheets("DATA BASE")
        .Range("A:G").Sort _
         Key1:=Sheets("DATA BASE").Range("B1").Value, _
         Order1:=xlAscending, Header:=xlYes
         With Range("H2")
            .Formula = "=today()"
            With .Resize(Range("G" & Rows.Count).End(xlUp).Row - 1)
                 .FillDown
                 .Copy
                 .PasteSpecial xlPasteValues
            End With
         End With
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Ha um defeito proposital no código, e você vai decidir como queira adaptar.

Imagine que toda vez que usar a rotina acima, os dados serão postos sempre um em baixo do outro, ou seja, os dados antigos não serão apagados!!!

Quanto ao fato de inserir linha em uma base eu achoe isso estranho, mas é só usar a rotina que eu fiz na primeira postagem.

Att

Boa noite alexandrevba.

Muito obrigado pela resposta.
Efetuei os testes e agora está perfeito.
Eu gostei desse jeito de ensinar pois além a ajudar nós aprendemos também.
O defeito proposital do código eu consegui achar graças a uma dica de um tópico anterior que recebi dos mestres Wagner Morel e Mauro Coutinho.
Fui executando a macro passo a passo apertando F8 ai descobri o defeito e adaptei a minha planilha.
Agradeço de coração espero um dia retribuir esta gentileza.

Agora vou tentar resolver o problema No 2 e caso não conseguir resolver voltarei aqui para pedir socorro.Rs

Abraços.

Boa noite!!

Vamos tentar a segunda parte agora.

Você mandará somente para Peque e Médio (da forma como está o arquivo que postou no fórum)?

Att

Boa noite alexandrevba

Muito obrigado!

Tenho que mandar valores da coluna B (NÚMERO) e coluna G (VALOR) da plan COLAR DADOS para FORMULÁRIO conforme o critério PEQUENO, MÉDIO e GRANDE que consta na plan COLAR DADOS.

Creio que se der uma olhada na plan FORMULÁRIO da pra entender melhor.Rs

Via macro não sei como fazer mas talvez via fórmula eu consiga.
O problema é que como vai ser uma planilha onde várias pessoas vão ter acesso se alguém apagar sem querer (ou querendo) a fórmula vai atrapalhar no meu controle.

Novamente agradeço a sua ajuda!

Abraços.

Boa tarde!!

Veja se é isso, caso contrário tente adaptar.
http://www.sendspace.com/file/c5qydi

Att

Bom dia alexandrevba Tudo bem?

Era quase isso que preciso na verdade existe a necessidade que as informações sejam inseridas a partir da linha 9 em diante.
Alterei algumas coisas mas não consegui adaptar para minha necessidade.
Alias percebi que você ocultou a planilha de onde as informações estavam sendo copiadas seria mais um defeito proposital ?? Rs
Fiquei um tempo quebrando a cabeça para descobrir ... Mas achei excelente esse modo de ensinar !!Rs

Abraços

Bom dia!!

Então eu preciso ver seu novo arquivo, pois, o código foi feito considerando o Lay-Out que eu deixe disposto.

Att

Olá alexandre vba.

Tentei mudar os valores dos campos abaixo para adaptar em minha planilha mas não funcionou.
Estou fuçando mais um pouco para ver se encontro algo que posso resolver.

.Range("A1:G" & lRow).AutoFilter Field:=1, Criteria1:="PEQUENO"
.Range("B2:B" & lRow).Copy Worksheets("FORMULARIO").Range("B" & Rows.Count).End(xlUp).Offset(1)

Range("A1:G" & lRow).AutoFilter Field:=1, Criteria1:="MEDIO"
.Range("B2:B" & lRow).Copy Worksheets("FORMULARIO").Range("L" & Rows.Count).End(xlUp).Offset(1)

.Range("A1:G" & lRow).AutoFilter Field:=1, Criteria1:="GRANDE"
.Range("B2:B" & lRow).Copy Worksheets("FORMULARIO").Range("V" & Rows.Count).End(xlUp).Offset(1)

Estou anexando o arquivo.
Desde já agradeço a atenção.
Abraços

Bom dia!!

Tentei copiar que foi feito na planilha anterior porém não consigo adaptar a minha planilha.
O que estou fazendo de errado?
Desde já agradeço a ajuda.

Abraços.

Bom dia!!
Altere a Sub Deletar para....

Sub Deletar()
Dim lRow As Long
Worksheets("FORMULARIO").Range("A2:AA10000").ClearContents
    Application.ScreenUpdating = False
    With Sheet1
        .AutoFilterMode = False
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:G" & lRow).AutoFilter Field:=1, Criteria1:="PEQUENO"
        .Range("B2:B" & lRow).Copy Worksheets("FORMULARIO").Range("B" & Rows.Count).End(xlUp).Offset(8)
        .Range("G2:G" & lRow).Copy Worksheets("FORMULARIO").Range("G" & Rows.Count).End(xlUp).Offset(8)
        .Range("A1").AutoFilter
    End With
    With Sheet1
        .AutoFilterMode = False
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:G" & lRow).AutoFilter Field:=1, Criteria1:="MEDIO"
        .Range("B2:B" & lRow).Copy Worksheets("FORMULARIO").Range("L" & Rows.Count).End(xlUp).Offset(8)
        .Range("G2:G" & lRow).Copy Worksheets("FORMULARIO").Range("Q" & Rows.Count).End(xlUp).Offset(8)
        .Range("A1").AutoFilter
    End With
    With Sheet1
        .AutoFilterMode = False
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:G" & lRow).AutoFilter Field:=1, Criteria1:="GRANDE"
        .Range("B2:B" & lRow).Copy Worksheets("FORMULARIO").Range("V" & Rows.Count).End(xlUp).Offset(8)
        .Range("G2:G" & lRow).Copy Worksheets("FORMULARIO").Range("AA" & Rows.Count).End(xlUp).Offset(8)
        .Range("A1").AutoFilter
    End With
    
    Range("B8,L8,V8").Value = "NÚMERO"
    Range("C8,M8,W8").Value = "COD"
    Range("D8,N8,X8").Value = "VALOR"
    Range("E8,O8,Y8").Value = "TAXA ADICIONAL"
    Range("F8,P8,Z8").Value = "IMPOSTO"
    Range("G8,Q8,AA8").Value = "VALOR"

    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Att