Jump to content

[RESOLVIDO]Advance filters


Recommended Posts

Alguém tem experiência em advance filters?

Tenho uma tabela que começa na célula M53 e acaba na célula Q99 (M53:Q99)

Nesta tabela são importados valores de uma outra folha através de um código VBA

Depois tenho na mesma folha uma outra tabela com o range A53:I72

Quando são importados os dados vem uma descrição na coluna M, um valor na coluna N, outro valor na coluna P e outro na coluna Q

Ex:

M53: Demolições

N53: 1000€

P53: 10

Q53: 2

Acontece que existe determinadas colunas que têm o valor zero por não existir valor.

O que pretendia era com base na coluna N filtrar para excluir os dados com valor zero e copiar os dados para a tabela 2

da seguinte forma:

M53 passa para a A53

N53 passa para a F53

O53 passa para a D53

Ou pensam que existe uma maneira mais facil e rápida de fazer isto? Agradeço as vossas opiniões.

Obrigado

http://img69.imageshack.us/img69/7384/imageyfy.th.jpg

Uploaded with ImageShack.us

Link to comment
Share on other sites

Esqueci-me de colocar aqui como resolvi ?

segui a sugestão do Tuntankamon e criei um ciclo.

Sub Subemp()
Application.ScreenUpdating = False


Dim lastRow As Long
        Dim lastResultRow As Long
        Dim x As Long
        
        ' Verifica qual a ultima célula preenchida
        lastRow = Cells(Rows.Count, 14).End(xlUp).Row
        
        Range("A53:F80").ClearContents
                
        lastResultRow = 53 ' linha onde vai começar
        
        ' Ciclo em todas as linhas
        For x = 53 To lastRow
        
           ' verifica se o valor é maior que zero
           If Cells(x, 14).Value > 0 Then
           
                ' Copia os valores
                Cells(lastResultRow, 6).Value = Cells(x, 14).Value
                Cells(lastResultRow, 4).Value = Cells(x, 15).Value
                Cells(lastResultRow, 1).Value = Cells(x, 13).Value
                               
                lastResultRow = lastResultRow + 1
           
           
           End If
           
           Next


Application.ScreenUpdating = True

End Sub

Cumprimentos e Obrigado

Miguel

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.