Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Filtrar e copiar pa...
 
Notifications
Clear all

Filtrar e copiar para outra planilha

 
2024 - VBA & Macros
Post Recente por Fabiosp 11 anos atrás
8 Posts
2 Usuários
0 Reactions
1,518 Visualizações
RSS
 Fabiosp
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Bom dia prezados senhores.

Tenho um problema e espero novamente contar com a ajuda dos senhores.

Necessito copiar 2 informações que estão em outra planilha.
As informações necessárias são "600008" que esta na coluna C e "verificado" que esta na coluna K.
Esta planilha foi nomeada como relatorio e esta divida em 12 abas (cada aba foi nomeada com o mês Jan-13 ~ Dec-13).
Queria que a macro verifique cada aba e copie as informações e cole em uma outra planilha que foi nomeada como relatorio geral.
Lembrando que existem informações diferentes tanto na coluna C quanto na coluna K.
Espero que com minha explicação seja possível entender que eu necessito.
Desde já agradeço a todos colegas deste fórum.
Abraços

 
Postado : 27/11/2013 5:38 am
 Fabiosp
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Prezados colegas

Desculpe incomoda-los
Estava verificando minhas planilhas na verdade necessito que seja filtrado a informação "verificado" que esta na coluna K e depois toda essa linha seja copiada para a outra planilha "relatório geral"
Estou anexando minhas planilhas para ficar mais fácil.

Desde já agradeço a todos colegas deste fórum.

Abraços.

RELATORIO GERAL.rar
 
Postado : 27/11/2013 8:39 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Fabiosp,

Bom Dia!

Para testar, apague todo o conteúdo do arquivo Relatório Geral e clique no botão Copiar Dados.

Veja se assim lhe atende.

RELATORIO.zip

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 27/11/2013 9:58 am
 Fabiosp
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Prezado Wagner Morel boa tarde,

Testei a macro é era mais ou menos isso que eu precisava muito obrigado pela ajuda.
Sem querer abusar da sua boa vontade caro colega, mas percebi que se apertar o botão 2 vezes ela copia a mesma informação e isso pode gerar duplicidade.
Será que teria como evitar isso?

Desde agradeço a ajuda.

Abraços.

 Sub CopiarDados()
    Dim i, j, UltimaLinhaGeral, UltimaLinhaRelat As Long
    Application.ScreenUpdating = False
    UltimaLinhaGeral = Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Cells(Cells.Rows.Count, 11).End(xlUp).Row + 1
    If UltimaLinhaGeral < 2 Then UltimaLinhaGeral = 2
    
    Workbooks("RELATORIO.xls").Activate
    For i = 1 To Sheets.Count
        Sheets(i).Select
        UltimaLinhaRelat = ActiveSheet.Cells(Cells.Rows.Count, 11).End(xlUp).Row
        If UltimaLinhaRelat < 2 Then UltimaLinhaRelat = 2
        For j = 2 To UltimaLinhaRelat
            If Trim(Range("K" & j).Value) = "verificado" Then
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("A" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("A" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("B" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("B" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("C" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("C" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("D" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("D" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("E" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("E" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("F" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("F" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("G" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("G" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("H" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("H" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("I" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("I" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("J" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("J" & j).Value
                Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("K" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("K" & j).Value
                UltimaLinhaGeral = UltimaLinhaGeral + 1
            End If
        Next
    Next
    Sheets("JAN-13").Select
    Workbooks("RELATORIO GERAL.xls").Activate
    Application.ScreenUpdating = True
    MsgBox "Dados Copiados com Sucesso!", vbDefaultButton1, "CﾓPIA DE DADOS"
End Sub
 
Postado : 27/11/2013 11:05 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Sim, é possível.

Para isto, basta você colocar um apóstrofo no início da linha UltimaLinhaGeral = Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Cells(Cells.Rows.Count, 11).End(xlUp).Row + 1, dessa forma:

'UltimaLinhaGeral = Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Cells(Cells.Rows.Count, 11).End(xlUp).Row + 1

Isso fará com que a última linha do Relatório Geral sejam sempre igual a 2. Assim, sempre que clicar no botão, todos os dados serão copiados a partir da linha 2 e, se já tiver algo a partir dessa linha, será sobrescrito pelos novos dados.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 27/11/2013 11:22 am
 Fabiosp
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Prezado Wagner Morel

Muito obrigado pela ajuda.
Testei e realmente funciona.rs
Eu apago tudo que tem na planilha relatório geral e depois aperto aperto o botão ai copia tudo.
Se eu não apagar as informações que já esta na planilha mesmo apertando o botão não é feita a atualização.
È isso mesmo?

Desde de já agradeço a compreensão caro colega.

Abraços.

      Sub CopiarDados()
        Dim i, j, UltimaLinhaGeral, UltimaLinhaRelat As Long
        Application.ScreenUpdating = False
 
    'UltimaLinhaGeral = Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Cells(Cells.Rows.Count, 11).End(xlUp).Row + 1


        If UltimaLinhaGeral < 2 Then UltimaLinhaGeral = 2
       
        Workbooks("RELATORIO.xls").Activate
        For i = 1 To Sheets.Count
            Sheets(i).Select
            UltimaLinhaRelat = ActiveSheet.Cells(Cells.Rows.Count, 11).End(xlUp).Row
            If UltimaLinhaRelat < 2 Then UltimaLinhaRelat = 2
            For j = 2 To UltimaLinhaRelat
                If Trim(Range("K" & j).Value) = "verificado" Then
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("A" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("A" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("B" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("B" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("C" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("C" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("D" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("D" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("E" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("E" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("F" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("F" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("G" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("G" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("H" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("H" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("I" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("I" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("J" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("J" & j).Value
                    Workbooks("RELATORIO GERAL.xls").Sheets("RELATORIO GERAL").Range("K" & UltimaLinhaGeral).Value = Workbooks("RELATORIO.xls").ActiveSheet.Range("K" & j).Value
                    UltimaLinhaGeral = UltimaLinhaGeral + 1
                End If
            Next
        Next
        Sheets("JAN-13").Select
        Workbooks("RELATORIO GERAL.xls").Activate
        Application.ScreenUpdating = True
        MsgBox "Dados Copiados com Sucesso!", vbDefaultButton1, "CﾓPIA DE DADOS"
    End Sub
 
Postado : 27/11/2013 11:43 am
Wagner Morel
 Wagner Morel
(@wagner-morel-vidal-nobre)
Posts: 0
Illustrious Member
 

Sim. É isso mesmo.

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

 
Postado : 27/11/2013 1:52 pm
 Fabiosp
(@fabiosp)
Posts: 291
Reputable Member
Topic starter
 

Wagner Morel

Muito obrigado prezado colega.
Sua ajuda foi muito útil.

Abraços

 
Postado : 27/11/2013 5:23 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico