Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Filtrar de uma Plan...
 
Notifications
Clear all

Filtrar de uma Planilha para outra

 
2024 - VBA & Macros
4 Posts
3 Usuários
0 Reactions
1,093 Visualizações
RSS
 guma
(@guma)
Posts: 135
Estimable Member
Topic starter
 

E ai?

Estou tentando fazer um filtro em VBA de uma planilha para outra.
adaptei um código ficou assim

Sub comparar_copiar()
    Dim lng As Long
    Dim n As Long
    Dim wks1 As Worksheet
    Dim wks2 As Worksheet

    Set wks1 = ThisWorkbook.Sheets("plan4")
    Set wks2 = ThisWorkbook.Sheets("Mat_Basicas")
    
    n = 3

        With wks2
        For lng = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            If Range("A" & lng).Value = wks1.Range("b1").Value Then
                
            
            wks1.Cells(n, "A") = wks2.Range("A" & lng)
            wks1.Cells(n, "B") = wks2.Range("B" & lng)
            wks1.Cells(n, "C") = wks2.Range("C" & lng)
            wks1.Cells(n, "D") = wks2.Range("D" & lng)
            wks1.Cells(n, "E") = wks2.Range("E" & lng)
            wks1.Cells(n, "F") = wks2.Range("F" & lng)
            wks1.Cells(n, "G") = wks2.Range("G" & lng)
            n = n + 1
            
            
           
     Else
       End If
     Next lng
  End With
End Sub

Mas não tá funcionando :oops:
Alguém sabe o que estou fazendo de errado, ou tem um código melhor para essa função ?

O objetivo é sempre que achar uma determinada palavra na coluna A da plan1 levar as 7 primeiras células da linha para a próxima linha em branco da plan2.

Att

 
Postado : 22/12/2014 2:14 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aparentemente o único motivo de não funcionar é por não ter encontrado a igualdade.
Lembre-se que Carta e diferente de CARTA.

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

 
Postado : 22/12/2014 2:47 pm
selmo
 selmo
(@selmo)
Posts: 236
Estimable Member
 

Então, só uma coisinha simples cara, você setou a planilha onde irá esta o critério a ser pesquisado, mas não setou a planilha a ser pesquisada, se estiver em uma aba diferente, vai dar erro e poderá não encontrar o item pesquisado, basta acrescentar o Wks2 a rotina de comparação, no caso 

 Wks2.Range("A" & lng).Value = wks1.Range("b1").Value Then

"A mente que se abre a uma nova ideia jamais voltará ao seu tamanho original."
Albert Einstein

 
Postado : 22/12/2014 3:09 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se entendi corretamente, e os ranges a serem copiados são fixos, tente a rotina abaixo :

Sub comparar_copiar_Mauro()
    Dim lng As Long
    Dim wks1 As Worksheet
    Dim wks2 As Worksheet

    Dim MyRg As Range
    Dim UltimaLinha As Long

    Set wks1 = ThisWorkbook.Sheets("plan4")
    Set wks2 = ThisWorkbook.Sheets("Mat_Basicas")
    
    'Verifica a Ultima Linha preenchida na aba Destino
    With wks1
        UltimaLinha = .Cells(.Rows.Count, "A").End(xlUp).Row
        'Se for a linha 1
        If UltimaLinha = 1 Then
            'Ajusta para inciar na linha 3
            UltimaLinha = 3
        Else
            'Se não Soma mais uma para a proxima linha em branco
            UltimaLinha = UltimaLinha + 1
        End If
    
    End With

    With wks2
        
        For lng = 2 To wks2.Cells(.Rows.Count, "A").End(xlUp).Row
            
            If wks2.Range("A" & lng).Value = wks1.Range("b1").Value Then
            'Definimos o Range
            Set MyRg = wks2.Range("A" & lng, wks2.Range("A" & lng).End(xlToRight))
                'Copiamos para a aba  de destino
                MyRg.Copy Destination:=wks1.Cells(UltimaLinha, "A")
                
            'Alimentamos a  variavel da Linha
            UltimaLinha = UltimaLinha + 1
           
            Else
            End If
        
        Next lng
        
    End With
  
End Sub

[]s

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

 
Postado : 22/12/2014 6:24 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico