none
URGENTE - Copiar colunas específicas de uma planilha e colar em uma nova sheet RRS feed

  • Pergunta

  • Boa tarde a todos!

    Estou desenvolvendo uma planilha no trabalho, mas encontrei uma dificuldade na hora de copiar algumas colunas para a nova sheet. 

    O que acontece é que diariamente recebemos uma base de dados com 200 colunas e mais de 6000 linhas e meu objetivo é filtrar apenas as linhas que nos interessa e copiar para uma outra sheet essas linhas e as colunas que vamos precisar. O primeiro passo, de excluir as linhas que não me interessam eu consegui fazer. Coloquei uma condicional no fim da planilha e criei uma macro que exclui todas as linhas que se encaixam nessa condicional.

    O que preciso agora é, depois desse filtro, copiar as colunas J, M, N, AI e AJ para a nova sheet, assim podemos trabalhar em cima dos dados que nos interessam. Podem me ajudar?

    domingo, 20 de julho de 2014 19:32

Respostas

  • Boa Noite,

    Veja se o código abaixo lhe ajuda.

    Tomei como base, a coluna A para o flag do loop.

    Sub Teste()
    
    ' salva nome da planilha origem
    planilha = ActiveSheet.Name
    
    ' adiciona uma nova planilha
    Sheets.Add After:=ActiveSheet
    
    ' salva nome da planilha destino
    planilhaaux = ActiveSheet.Name
    
    linha = 1
    linhaaux = 1
    
    
    ' percorre as linhas da planilha origem até localizar uma linha vazia na coluna A
    Do While Sheets(planilha).Cells(linha, "a") <> ""
        ' Verifica o critério na coluna A
        If Sheets(planilha).Cells(linha, "a") = "SEU CRITÉRIO" Then
            
            ' atribui os valores das colunas origem na planilha destino
            Sheets(planilhaaux).Cells(linhaaux, "a") = Sheets(planilha).Cells(linha, "j")
            Sheets(planilhaaux).Cells(linhaaux, "b") = Sheets(planilha).Cells(linha, "m")
            Sheets(planilhaaux).Cells(linhaaux, "c") = Sheets(planilha).Cells(linha, "n")
            Sheets(planilhaaux).Cells(linhaaux, "d") = Sheets(planilha).Cells(linha, "ai")
            Sheets(planilhaaux).Cells(linhaaux, "e") = Sheets(planilha).Cells(linha, "aj")
            
            ' incremento
            linhaaux = linhaaux + 1
    
    
        End If
    ' incremento
    linha = linha + 1
    Loop
    
    End Sub
    

    Obs.: Como citado que você já conseguiu remover as linhas desnecessárias, talvez a condição SE do código possa ser removida.

    Abraço


    segunda-feira, 21 de julho de 2014 03:54

Todas as Respostas

  • Boa noite Gabi.

    A forma mais fácil que conheço de fazer isso é criando um Filtro Avançado. Assim vc pode realizar a filtragem dos dados e de quebra obter apenas as colunas que vc deseja, simplesmente escrevendo os nomes das colunas que deseja na planilha de destino (pode inclusive alterar a ordem, duplicar colunas, etc). Grave uma macro com o procedimento e veja o código gerado. É bastante simples. Você vai precisar apenas de um espaço contendo os nomes das colunas e o critério do filtro na linha abaixo desta (não precisa constar todas as colunas, apenas as que interessam) e dos nomes das colunas onde serão colados os resultados.

    Dica: Nomeie os intervalos: Dados, Critérios e Resultados. Fica muito mais flexível assim.

    Qualquer dúvida é só perguntar.


    Filipe Magno

    domingo, 20 de julho de 2014 21:26
  • Boa Noite,

    Veja se o código abaixo lhe ajuda.

    Tomei como base, a coluna A para o flag do loop.

    Sub Teste()
    
    ' salva nome da planilha origem
    planilha = ActiveSheet.Name
    
    ' adiciona uma nova planilha
    Sheets.Add After:=ActiveSheet
    
    ' salva nome da planilha destino
    planilhaaux = ActiveSheet.Name
    
    linha = 1
    linhaaux = 1
    
    
    ' percorre as linhas da planilha origem até localizar uma linha vazia na coluna A
    Do While Sheets(planilha).Cells(linha, "a") <> ""
        ' Verifica o critério na coluna A
        If Sheets(planilha).Cells(linha, "a") = "SEU CRITÉRIO" Then
            
            ' atribui os valores das colunas origem na planilha destino
            Sheets(planilhaaux).Cells(linhaaux, "a") = Sheets(planilha).Cells(linha, "j")
            Sheets(planilhaaux).Cells(linhaaux, "b") = Sheets(planilha).Cells(linha, "m")
            Sheets(planilhaaux).Cells(linhaaux, "c") = Sheets(planilha).Cells(linha, "n")
            Sheets(planilhaaux).Cells(linhaaux, "d") = Sheets(planilha).Cells(linha, "ai")
            Sheets(planilhaaux).Cells(linhaaux, "e") = Sheets(planilha).Cells(linha, "aj")
            
            ' incremento
            linhaaux = linhaaux + 1
    
    
        End If
    ' incremento
    linha = linha + 1
    Loop
    
    End Sub
    

    Obs.: Como citado que você já conseguiu remover as linhas desnecessárias, talvez a condição SE do código possa ser removida.

    Abraço


    segunda-feira, 21 de julho de 2014 03:54