locked
Copiar Dados de Várias Guias de Uma Planilha para uma nova Pasta de Trabalho RRS feed

  • Pergunta

  • Pessoal, preciso de uma super ajuda !

    Preciso copiar todas as linhas das colunas:  P; AH; AY; BP; CG; CX; DO; EF; EW; FN; GE; GV; HM; ID; IU;  para uma nova pasta de trabalho. Será copiada todas as colunas acima juntas de 4 Guias ( Plan1; Plan2; Plan3; Plan4 )

    Todas essas colunas acima mencionadas são resultado de uma concatenação de tabelas ao lado, com aplicação de auto-filtro. Essas colunas acima que serão copiadas, NÃO possui cabeçalho.

    Bom, preciso de um código que comece a copiar as colunas acima, a partir da Plan1 para a coluna A da Plan1 de uma nova pasta de trabalho de forma ordenada, onde completada a última linha da coluna A, continuaria na coluna B e assim sucessivamente.

    Se alguem puder me ajudar, agradeço !!
    quarta-feira, 6 de janeiro de 2010 18:35

Respostas

  • 1 ) Declare a varivel com (0 to 13)
    tem um campo a mais

    altere o while
    2 ) While Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(1)).Value <> "" and Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(2)).Value <> "" and
    Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(3)).Value <> "" and
    Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(4)).Value <> "" and
    ................
    até o 13
    dai ele só vai parar quando todas as coluns forem vazias

    Ok


    Wesley
    • Marcado como Resposta rodpx quinta-feira, 14 de janeiro de 2010 15:08
    quarta-feira, 13 de janeiro de 2010 09:32

Todas as Respostas

  • Mostre um exemplo
    Quando vc fala em ultima linha, vc quer dizer na linha 65536?

    e os dados vão ficar um embaixo do outro

    blz


    Wesley
    quinta-feira, 7 de janeiro de 2010 13:49
  • Boa Tarde Wesley !

    Sim, os dados vão ficar todos um embaixo do outro até a linha 65536 da coluna A da PLAN2 e se precisar passaria pra coluna B,C,D dando continuidade.

    Estou enviando abaixo um exemplo prático.

    Nesse exemplo, estou copiando todos os dados das colunas coloridas em verde ( resultado da aplicação de autofiltro e concatenação ), para a coluna A da PLAN2.

    Neste caso, ela começará a copiar os dados a partir da coluna P, depois AG; BO; CF; CW; DN; EE; EV; FM ....... pra coluna A da PLAN2 uma embaixo da outra. Quando a coluna A da PLAN2 estiver toda preenchida com os dados ( se for o caso ), automaticamente continuaria o preenchimento na coluna B da PLAN2 e assim sucessivamente.


    Segue a planilha pra baixar:

    http://www.sendspace.com/file/o9tyb0



    Obrigado!!
    quinta-feira, 7 de janeiro de 2010 16:14
  • Tente esse código
    Sub Copia_colunas()
    '
    ' Macro1 Macro
    ' Macro gravada em 08/01/2010 por wmatos
    '

    '
    ' criar matriz com as colunas
    'P; AH; AY; BP; CG; CX; DO; EF; EW; FN; GE; GV; HM; ID; IU;
    Dim aColunas(0 To 14) As Integer

    ' atribuir colunas o numero
    aColunas(0) = 1
    aColunas(1) = 2
    aColunas(2) = 3
    aColunas(3) = 4
    aColunas(4) = 5
    aColunas(5) = 6
    aColunas(6) = 7
    aColunas(7) = 8
    aColunas(8) = 9
    aColunas(9) = 10
    aColunas(10) = 26
    aColunas(11) = 27
    aColunas(12) = 28
    aColunas(13) = 29
    aColunas(14) = 30

    ' criar matriz com as abas
    Dim aAbas(0 To 3) As String
    aAbas(0) = "Plan1"
    aAbas(1) = "Plan2"
    aAbas(2) = "Plan3"
    aAbas(3) = "Plan4"

    ' Criar variavel com o nome da planilha
    Dim sPlanilha As String
    sPlanilha = "Exemplo3.xls"

    ' cria uma nova planilha
    Workbooks.Add
    ' Criar variavel para as linhas da nova planilha (Destino"
    Dim iLin As Long
    Dim iCol As Long
    iLin = 1
    iCol = 1
    ' Criar variavel para linha de origem
    Dim iiLin As Long
    iiLin = 1
        For i = 0 To 3
            For ii = 0 To 14
                While Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(ii)).Value <> ""

                    Cells(iLin, iCol).Value = Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(ii)).Text
                    iLin = iLin + 1
                    If iLin = 65537 Then
                        iLin = 1
                        iCol = iCol + 1
                    End If
                    Cells(iLin, iCol).Select
                    iiLin = iiLin + 1
                Wend
                iiLin = 1
            Next
        Next
    End Sub


    Wesley
    sexta-feira, 8 de janeiro de 2010 12:17
  • Wesley, muito obrigado pela ajuda !!!

    Uma parte do código funcionou perfeitamente. Copiou os dados das colunas em verde para outra Pasta, a partir da coluna A, uma embaixo da outra. Até aí tudo ok !!


    O erro que tá acontecendo é o seguinte:

    Os dados que estão sendo copiados, estão saindo desmembrados. Por exemplo:

    Tenho uma coluna com os dados: 04 14 00 22 35 17 25 39 44 41 16 13 24 28

    Ao invés de copiar a linha inteira da coluna, ele tá copiando a numeração separada, uma embaixo da outra:

    04
    14
    00
    22
    35
    17
    25
    39
    .
    .
    .

    Será que fiz algo errado ?

    []s
     
    sexta-feira, 8 de janeiro de 2010 16:13
  • Vc quer todos os valores em uma celula só


    Wesley
    segunda-feira, 11 de janeiro de 2010 10:22
  • Wesley, gostaria que fosse copiada a linha inteira das referidas colunas P; AH; AY; BP; CG; CX; DO; EF; EW; FN; GE; GV; HM; ID; IU.

    Então, um exemplo: se tiver na primeira linha da coluna (P1) : 04 14 00 22 35 17 25 39 44 41 16 13 24 28, na (P2): 04 14 00 22 35 17 25 39 44 41 16 13 24 28; quero que seja copiada essa linha por inteiro, com todos os numeros, para uma nova guia em branco, uma embaixo da outra.

    04 14 00 22 35 17 25 39 44 41 16 13 24 28
    04 14 00 22 35 17 25 39 44 41 16 13 24 28
    04 14 00 22 35 17 25 39 44 41 16 13 24 28
    04 14 00 22 35 17 25 39 44 41 16 13 24 28
    .
    .
    .
    .


    No código que você postou anteriormente ela tá fazendo a copia para a nova guia em branco uma embaixo da outra perfeitamente, só que tá saindo número por número e não a linha por inteiro.



    Obrigado!

    []s
    segunda-feira, 11 de janeiro de 2010 20:52
  • 'Entendi
    'então faça assim


    Sub Copia_colunas()
    '
    ' Macro1 Macro
    ' Macro gravada em 08/01/2010 por wmatos
    '

    '
    ' criar matriz com as colunas
    'P; AH; AY; BP; CG; CX; DO; EF; EW; FN; GE; GV; HM; ID; IU;
    Dim aColunas(0 To 14) As Integer

    ' atribuir colunas o numero
    aColunas(0) = 1
    aColunas(1) = 2
    aColunas(2) = 3
    aColunas(3) = 4
    aColunas(4) = 5
    aColunas(5) = 6
    aColunas(6) = 7
    aColunas(7) = 8
    aColunas(8) = 9
    aColunas(9) = 10
    aColunas(10) = 26
    aColunas(11) = 27
    aColunas(12) = 28
    aColunas(13) = 29
    aColunas(14) = 30

    ' criar matriz com as abas
    Dim aAbas(0 To 3) As String
    aAbas(0) = "Plan1"
    aAbas(1) = "Plan2"
    aAbas(2) = "Plan3"
    aAbas(3) = "Plan4"

    ' Criar variavel com o nome da planilha
    Dim sPlanilha As String
    sPlanilha = "Exemplo3.xls"

    ' cria uma nova planilha
    Workbooks.Add
    ' Criar variavel para as linhas da nova planilha (Destino"
    Dim iLin As Long
    Dim iCol As Long
    iLin = 1
    iCol = 1
    ' Criar variavel para linha de origem
    Dim iiLin As Long
    iiLin = 1
        For i = 0 To 3
           While Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(1)).Value <> ""
                 For ii = 0 To 14
                    Cells(iLin, iCol).Value = Cells(iLin, iCol).Text & " " & Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(ii)).Text
                 Next
                iLin = iLin + 1
                If iLin = 65537 Then
                    iLin = 1
                    iCol = iCol + 1
                End If
                Cells(iLin, iCol).Select
                iiLin = iiLin + 1
            Wend
            iiLin = 1
        Next
    End Sub


    Wesley
    terça-feira, 12 de janeiro de 2010 11:30
  • Wesley, obrigado mais uma vez !!


    O problema de copiar a linha inteira foi resolvido, mas o código continua apresentando algumas falhas:


    1)  Cada linha da coluna a ser copiada possuiu 14 números, mas ele tá copiando com um número extra em todas as linhas, que se não me engano é o número da coluna L. Então no final, ele tá copiando 15 números e não 14.


    2) Quando ele começa a fazer a cópia e passa por alguma linha em branco da coluna P, ele para. Então se na coluna P12 tiver uma linha em branco, ele só copia os dados das 11 linhas antes, não passando pras demais linha e colunas.

    Obrigado!!

    []s
    terça-feira, 12 de janeiro de 2010 19:40
  • 1 ) Declare a varivel com (0 to 13)
    tem um campo a mais

    altere o while
    2 ) While Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(1)).Value <> "" and Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(2)).Value <> "" and
    Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(3)).Value <> "" and
    Workbooks(sPlanilha).Sheets(aAbas(i)).Cells(iiLin, aColunas(4)).Value <> "" and
    ................
    até o 13
    dai ele só vai parar quando todas as coluns forem vazias

    Ok


    Wesley
    • Marcado como Resposta rodpx quinta-feira, 14 de janeiro de 2010 15:08
    quarta-feira, 13 de janeiro de 2010 09:32
  • Wesley, valeu pela ajuda !!!


    Muito Obrigado !!!
    quinta-feira, 14 de janeiro de 2010 15:20
  • Bom dia Wesley,

    Sou novo por aqui e não entendo muito bem como perguntar e responder. Gostaria que me tirasse uma dúvida se possível. Tenho uma pasta com várias planilhas, + ou - 800 planilhas. Todo final de semestre, tenho q fazer uma única nova planilha com 2 dados de cada uma das 800.

    Ex: Das 800 planilhas tenho q copiar as células C14, C16 e E40 para que seja montada uma nova relação em uma nova planilha somente com esses 3 dados.

    Gostaria que se possível me respondesse por e-mail, pois como disse antes n tenho costume em forum.

    guiquintans@ig.com.br

    obrigado.

    quinta-feira, 13 de maio de 2010 14:13
  • Tente esse código

     

    Sub Copia_Celulas()
    '
    ' Macro1 Macro
    '

    '
    Dim sNamePasta As String

    ' Nome da Pasta onde estão as celulas

    sNamePasta = "Pasta1"

        Workbooks.Add
       
      For i = 1 To Workbooks(sNamePasta).Sheets.Count
        Cells(ActiveCell.Row, 1).Value = Workbooks(sNamePasta).Sheets(i).Range("C14").Text
        Cells(ActiveCell.Row, 2).Value = Workbooks(sNamePasta).Sheets(i).Range("C16").Text
        Cells(ActiveCell.Row, 3).Value = Workbooks(sNamePasta).Sheets(i).Range("E40").Text

        ActiveCell.Offset(1, 0).Select
      Next
    End Sub


    Wesley Cesar
    segunda-feira, 17 de maio de 2010 12:03
  • Desculpe Wesley, mas sou leigo no excel. Gostaria que me desse uma ajuda passo a passo.

    a pasta está na rede e o nome é "P:\Parcelamentos referentes ao período de 2009.2"

    a mesma encontra-se junto com as demais 800, então dentro dessa pasta eu tenho 801, sendo as 800 que eu quero copiar os dados e essa 1 que eu quero que os dados sejam copiados.

    Ficarei grato se puder me ajudar.

    Guilherme Quintans

    segunda-feira, 17 de maio de 2010 12:19