none
Como Transpor uma linha em uma coluna - Excel

    Question

  • Bom dia gente preciso de um help...faz muito tempo que não mexo no vba do excel e acabei meio que esquecendo...Bom preciso aqui no serviço de uma macro que mude o conteúdo de uma linha para colunas. Segue print que mostra como esta e como preciso que esteja.

    como e :

    como preciso que seja:

     

    Friday, January 27, 2012 12:21 PM

All replies

  • Cara, se puder ser ficar assim fica bem mais fácil

    O que acha?

    Friday, January 27, 2012 1:02 PM
  • Eu sei q e bem mais facil, mas preciso desse formato pq eu importo ela no c# !
    Friday, January 27, 2012 1:08 PM
  • execute essa macro e veja se funciona., Poste o resultado

     

    Sub TranspoeColuna()

     

        Dim Celula As Range

     

     

        Range("A600").End(xlUp).Offset(2, 0).Value = "PRODUTO"

        Range("A600").End(xlUp).Offset(0, 1).Value = "QTD"

        Range("A600").End(xlUp).Offset(0, 2).Value = "DATA"

     

        Set Celula = Range("A2")

     

        Do While Celula.Value <> ""

     

        Range(Celula.Offset(0, 1).Address & ":" & Celula.Offset(0, 100).End(xlToLeft).Address).Copy

     

        Range("B500").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

            False, Transpose:=True

     

        Range(Celula.Address).Copy

        Range(Range("A500").End(xlUp).Offset(1, 0).Address & ":" & _

        Range("B500").End(xlUp).Offset(0, -1).Address).PasteSpecial

     

         Set Celula = Celula.Offset(1, 0)

     

        Range("B1:" & Range("B1").Offset(0, 500).End(xlToLeft).Address).Copy

     

        Range("C500").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

            False, Transpose:=True

     

        Loop

     

    End Sub

    Friday, January 27, 2012 2:16 PM
  • Bom dia, esta macro na executa, da erro cara.
    Monday, January 30, 2012 1:58 PM
  • Qual erro?
    Monday, January 30, 2012 3:01 PM
  • Ola, aparece este erro:

     

    Monday, January 30, 2012 5:05 PM
  • Se vc copiou e colou del pode estar interpretando errado as quebrasd de linha, quando vc clica em debug qual linha ele mostra? Tente copiar e colar este novamente!

    Repare que os valores A600 B500 são chutes do final da linha, vc deve alerar esses valores se suas linhas e colunas forem maiores que isso.

     

    Sub TranspoeColuna()
    
    
        Dim Celula As Range
    
        Range("A600").End(xlUp).Offset(2, 0).Value = "PRODUTO"
    
        Range("A600").End(xlUp).Offset(0, 1).Value = "QTD"
    
        Range("A600").End(xlUp).Offset(0, 2).Value = "DATA"
    
    
        Set Celula = Range("A2")
    
     
    
        Do While Celula.Value <> ""
    
     
    
        Range(Celula.Offset(0, 1).Address & _
        ":" & Celula.Offset(0, 100). _
        End(xlToLeft).Address).Copy
    
    
        Range("B500").End(xlUp).Offset(1, 0). _
        PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
    
        Range(Celula.Address).Copy
    
        Range(Range("A500").End(xlUp). _
        Offset(1, 0).Address & ":" & _
        Range("B500").End(xlUp). _
        Offset(0, -1).Address).PasteSpecial
    
    
         Set Celula = Celula.Offset(1, 0)
    
    
        Range("B1:" & Range("B1").Offset(0, 500).End(xlToLeft).Address).Copy
    
        Range("C500").End(xlUp). _
        Offset(1, 0).PasteSpecial _
        Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
         Loop
    
     End Sub



    • Edited by robatsilva Monday, January 30, 2012 7:28 PM
    Monday, January 30, 2012 6:52 PM
  • Bom dia,

    cara agora ta quase indo bem, fiz uns ajustes para que ele transpõe a tabela em outro sheet pq acredito que fique melhor agora seguem print de como ta ficando:

    Tabela Base

    Tabela alterada:

    pode ver q ta fazendo o processo somente pelo primeiro produto, segue o código com evidenciada a parte que ta dando erro agora....

    Sub TransporColunas2()
    
    
        Dim Celula As Range
        
        Sheets("NOVO_BP").Select
    
        'Range("A600").End(xlUp).Offset(2, 0).Value = "PRODUTO"
        'Range("A600").End(xlUp).Offset(0, 1).Value = "QTD"
        'Range("A600").End(xlUp).Offset(0, 2).Value = "DATA"
        
        Range("A1").Value = "PRODUTO"
        Range("B1").Value = "QTD"
        Range("C1").Value = "DATA"
        
        
        Sheets("BP").Select
    
        Set Celula = Range("A2")
        
    
        Do While Celula.Value <> ""
    
        Range(Celula.Offset(0, 1).Address & _
        ":" & Celula.Offset(0, 100). _
        End(xlToLeft).Address).Copy
        
        Sheets("NOVO_BP").Select
        
        Range("B500").End(xlUp).Offset(1, 0). _
        PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
        Sheets("BP").Select
    
        Range(Celula.Address).Copy
        
        Sheets("NOVO_BP").Select
    
        Range(Range("A500").End(xlUp). _
        Offset(1, 0).Address & ":" & _
        Range("B500").End(xlUp). _
        Offset(0, -1).Address).PasteSpecial
        
        Sheets("BP").Select
    
        Set Celula = Celula.Offset(1, 0)
    
        Range("B1:" & Range("B1").Offset(0, 500).End(xlToLeft).Address).Copy 'DA PROBLEMA NESSA LINHA
        
        Sheets("NOVO_BP").Select
    
        Range("C500").End(xlUp). _
        Offset(1, 0).PasteSpecial _
        Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
         Loop
    
     End Sub
    te agradeço por estar me ajudando...acredito que agora e só um detalhe né ?!

    Fico no aguardo.

    Vlw

    Tuesday, January 31, 2012 11:22 AM
  • fiz uns testes, alterei algumas linhas, aki agora tá funcionando. copia e cola, execute e informa se deu certo. Caso de algum erro, informa qual erro está dando e qual linha.

    Sub TransporColunas2()
    
    
        Dim Celula As Range
        Dim UltimaLinha As Long
        Dim UltimaColuna As Integer
        
        
        Sheets("NOVO_BP").Select
    
        'Range("A600").End(xlUp).Offset(2, 0).Value = "PRODUTO"
        'Range("A600").End(xlUp).Offset(0, 1).Value = "QTD"
        'Range("A600").End(xlUp).Offset(0, 2).Value = "DATA"
        
        Range("A1").Value = "PRODUTO"
        Range("B1").Value = "QTD"
        Range("C1").Value = "DATA"
        
        
        Sheets("BP").Select
    
        Set Celula = Range("A2")
        
    
        Do While Celula.Value <> ""
        
        Sheets("BP").Select
        
        UltimaColuna = Columns.Count - 1
        
        Range(Celula.Offset(0, 1).Address & _
        ":" & Celula.Offset(0, UltimaColuna). _
        End(xlToLeft).Address).Copy
        
        Sheets("NOVO_BP").Select
        
        UltimaLinha = Rows.Count - 1
        
        Range("B" & UltimaLinha).End(xlUp).Offset(1, 0). _
        PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        
        Sheets("BP").Select
    
        Celula.Copy
        
        Sheets("NOVO_BP").Select
    
        Range(Range("A" & UltimaLinha).End(xlUp). _
        Offset(1, 0).Address & ":" & _
        Range("B" & UltimaLinha).End(xlUp). _
        Offset(0, -1).Address).PasteSpecial
        
        Sheets("BP").Select
    
        Set Celula = Celula.Offset(1, 0)
    
        Range("B1:" & Range("B1").Offset(0, UltimaColuna - 1).End(xlToLeft).Address).Copy 'DA PROBLEMA NESSA LINHA
        
        Sheets("NOVO_BP").Select
    
        Range("C" & UltimaLinha).End(xlUp). _
        Offset(1, 0).PasteSpecial _
        Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    
         Loop
    
     End Sub


     

    • Proposed as answer by Giovani Cruzara Wednesday, September 25, 2013 12:36 PM
    Tuesday, January 31, 2012 2:43 PM
  • Valeu robatsilva , cara rodou certinho !!! Muito Obrigado.
    • Proposed as answer by Fabio Rhein Tuesday, January 31, 2012 3:49 PM
    Tuesday, January 31, 2012 3:22 PM
  • Galera,

    Fiz de uma forma mais consolidada.

    Caso queiram mais de uma solução:

    Sub Transpor()
    
    Plan2.Cells(1, 1).Value = "Produto"
    Plan2.Cells(1, 2).Value = "QTD"
    Plan2.Cells(1, 3).Value = "Data"
    
    I = 2
    k = 2
    Z = 2
    While Plan1.Cells(I, 1).Value <> ""
        J = 2
        While Plan1.Cells(I, J).Value <> ""
            Plan2.Cells(Z, 1).Value = Plan1.Cells(I, 1).Value
            Plan2.Cells(Z, 2).Value = Plan1.Cells(I, J).Value
            Plan2.Cells(Z, 3).Value = Plan1.Cells(1, J).Value
            
            J = J + 1
            Z = Z + 1
        Wend
        I = I + 1
    Wend
    
    MsgBox "Operação Feita com sucesso!", vbInformation, "Informação"
    
    End Sub


    • Proposed as answer by Fabio Rhein Tuesday, January 31, 2012 3:50 PM
    Tuesday, January 31, 2012 3:50 PM
  • Karaka, muito ninja.
    Tuesday, January 31, 2012 4:19 PM
  • Prezado Robatsilva,

    Parabéns pelo trabalho. De fato não ajudou, tão somente, o colega que postou a dúvida, mas, a mim também.

    Eu queria aproveitar esta postagem para fazer uma pergunta. Pode ser que seja uma coisa tranquila, mas, como não sou desenvolvedor e não conheço a lógica do VBScript, prefiro pedir ajuda aos "universitário".

    Pois bem, como eu faria para, ao invés de usar 3 colunas para receber os resultados eu usasse 4? Que tipo de alterações deveriam ser feitas no código?

    Por exemplo: ao invés de termos PRODUTO, QTD, DATA; Teríamos PRODUTO, MARCA, QTD, DATA e assim por diante. Que trecho do código preciso editar para, inclusive, incluir mais colunas no BD produzido a partir da transposição?

    Antecipadamente agradeço.

    Wisley Velasco

    Wednesday, September 25, 2013 1:38 AM
  • Prezado Fabio Rhein,

    Primeiramente parabéns pelo trabalho. De fato ajudou, não só o colega que postou a dúvida, mas, a mim também.

    Eu queria aproveitar a pergunta que fiz para o Robatsilva e fazer a mesma pergunta pra você. Pode ser que seja uma coisa tranquila, mas, como não sou desenvolvedor e não conheço a lógica do VBScript, prefiro pedir ajuda aos "universitário".

    É o seguinte, como eu faria para, ao invés de usar 3 colunas para receber os resultados eu usasse 4? Que tipo de alterações deveriam ser feitas no seu código?

    Por exemplo: ao invés de termos PRODUTO, QTD, DATA; Teríamos PRODUTO, MARCA, QTD, DATA e assim por diante. Que trecho do código preciso editar para, inclusive, incluir mais colunas no BD produzido a partir da transposição?

    Antecipadamente agradeço.

    Wisley Velasco

    Wednesday, September 25, 2013 1:47 AM
  • Existe uma forma bem fácil de se fazer isso.

    (considere a tabela da primeira postagem deste tópico)

    1 - Selecione o intervalo A1:L4 e pressione Ctrl+C

    2 - Selecione o intervalo A6:D17

    3 - Digite a fórmula =TRANSPOR(A1:L4) e pressione Ctrl+Shift+Enter.



    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    Wednesday, October 02, 2013 1:11 AM
    Moderator
  • Prezado Felipe Costa (Benzadeus)

    Sua dica é interessante e prática. Todavia, transpor, simplesmente, as colunas em linhas, não resolve a minha necessidade e não fica igual ao resultado do exemplo do início do post. Se você reparar, a coluna "produto" não é transposto, pois é a referência dos registros.

    De qualquer forma, muitíssimo obrigado por sua disposição em contribuir comigo e com os demais que farão uso destes posts.

    Abraços.

    Wisley Velasco

    Wednesday, October 02, 2013 10:56 AM