none
Copiar e colar com criterios RRS feed

  • Pergunta

  • Boa noite!

    Estou usando....Excel 2007

    Pessoal gostaria de fazer uma cópia de um dados numa Aba chamada "macro" para outras abas .

    Onde o código vai ler a coluna "C" e apartir de um criterio copiará todas as lihas dentro dessas condições.

    Exemplo: da aba "Macro " quero copiar e colar (caso na coluna"D" não esteje vazia), na aba "Fracionados " somente as linhas que tenha base na coluna "C" onde temos "103" e "108"

    Da aba "Macro " quero quero copiar e colar (caso na coluna"D" não esteje vazia),na aba "Separação " somente as linhas que tenha base na coluna "C" onde temos "102" e "107"

    Da aba "Macro " quero quero copiar e colar na aba "Pro-sem Endereço " somente as linhas que tenha base na coluna "D " onde temos nesta coluna tudo que está VAZIO.

    Segue o link abaixo..

     

    Alguem poderia me ajudar ..Muito Obrigado!!!

    http://www.4shared.com/file/E6AGRTEt/Relatrio.html

     

     

    Att..


    zinho
    quarta-feira, 16 de fevereiro de 2011 20:48

Respostas

  • Zinho,

    criei uma sub para resolver o seu problema

    é apenas o esqueleto, voce tem que colocar a sua regra de negocio nela.

    da uma olhada:

    Sub copiarColarCriterio()
    'congela a imagem ( ganha performance)
    Application.ScreenUpdating = False
    Sheets("Macro").Select
    Dim n As Integer
    Dim k As Integer
    'percorre a sh Macro
    'no caso estou jogando para a plan2, crie sua regra.
    For n = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      Sheets("Macro").Select
      If Cells(n, 3) = "Criterio1" Then
        Rows(n).Select
        Selection.Copy
        Sheets("Plan2").Select
        k = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(k).Select
        ActiveSheet.Paste
      End If
      If Cells(n, 5) = "Criterio2" Then
        Rows(n).Select
        Selection.Copy
        Sheets("Plan3").Select
        k = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(k).Select
        ActiveSheet.Paste
      End If
      
    Next
    
    Application.ScreenUpdating = True
    End Sub

    Caio Vitullo
    quarta-feira, 16 de fevereiro de 2011 23:28

Todas as Respostas

  • Zinho,

    criei uma sub para resolver o seu problema

    é apenas o esqueleto, voce tem que colocar a sua regra de negocio nela.

    da uma olhada:

    Sub copiarColarCriterio()
    'congela a imagem ( ganha performance)
    Application.ScreenUpdating = False
    Sheets("Macro").Select
    Dim n As Integer
    Dim k As Integer
    'percorre a sh Macro
    'no caso estou jogando para a plan2, crie sua regra.
    For n = 1 To Cells(Rows.Count, 1).End(xlUp).Row
      Sheets("Macro").Select
      If Cells(n, 3) = "Criterio1" Then
        Rows(n).Select
        Selection.Copy
        Sheets("Plan2").Select
        k = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(k).Select
        ActiveSheet.Paste
      End If
      If Cells(n, 5) = "Criterio2" Then
        Rows(n).Select
        Selection.Copy
        Sheets("Plan3").Select
        k = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Rows(k).Select
        ActiveSheet.Paste
      End If
      
    Next
    
    Application.ScreenUpdating = True
    End Sub

    Caio Vitullo
    quarta-feira, 16 de fevereiro de 2011 23:28
  • Obrigado mesmo !!!..Caio mas deu errado ....não se preocupe vou tentar acertar...

    As informações não forma coladas na planilha destino.

     

    Valeu..abraços


    zinho
    sexta-feira, 18 de fevereiro de 2011 00:20