Este fórum foi descontinuado. LEIA AQUI e participe da Comunidade BABOO :)

A área de Remoção de Malwares está aberta na Comunidade BABOO. LEIA AQUI

Ir para conteúdo
nocturne07

Macro transpor linhas em colunas com identificador ao lado

Mensagem Recomendada

Olá, antes fiz um post, gostaria de esclarecer melhor o que eu quero:

Tenho: 

         A         B       C       D     E      F
1   Bruno   123   456   789
2   Pedro   321   654   987
3   João     159
4   Leo       951   753   357   753   183

Preciso que fique:

      A         B
1 Bruno   123  
2 Bruno   456
3 Bruno   789
4 Pedro   321
5 Pedro   654
6 Pedro   987
7 João     159
8 Leo       951
9 Leo       753
10 Leo     357
11 Leo     753
12 Leo     183

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, Bruno.

Se você quiser experimentar esta solução via macro, instale o código abaixo em um módulo comum, assim:
1. copie o código daqui
2. a partir da planilha em que estão os dados tecle 'Alt+F11' para acessar o editor de VBA
3. no menu do editor >> Inserir >> Módulo
4. cole o código na janela em branco que vai se abrir
5. feito! 'Alt+Q' para retornar para a planilha e testar

para rodar o código:
6. tecle 'Alt+F8' >> selecione a macro correspondente >> Executar, ou insira um botão na planilha e vincule-o à macro ou vincule-a a um atalho de teclado (Alt+F8 > Opções).

Sub RearranjaDados()
 Dim n As Range, k As Long, c As Long
  [M:N] = ""
  For Each n In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
   k = n.End(2).Column
    Cells(c + 1, 13).Resize(k - 1).Value = n.Value
    Cells(c + 1, 14).Resize(k - 1).Value = _
     Application.Transpose(n.Offset(, 1).Resize(, k - 1).Value)
    c = c + k - 1
  Next n
End Sub

 

obs. o resultado será colocado pelo código nas colunas 'M:N' a partir da linha 1.


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Boa tarde, gostaria de implementar esse tópico, fazendo o resultado sair em outra planilha nas colunas A e B

Sub RearranjaDados()
 Dim n As Range, k As Long, c As Long
  [A:B] = ""
  For Each n In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
   k = n.End(2).Column
    Plan2.Cells(c + 1, 1).Resize(k - 1).Value = n.Value
    Plan2.Cells(c + 1, 2).Resize(k - 1).Value = _
     Application.Transpose(n.Offset(, 1).Resize(, k - 1).Value)
    c = c + k - 1
  Next n
End Sub

 

Editado por ILAURATTO

Compartilhar este post


Link para o post
Compartilhar em outros sites

Acrescente as partes em vermelho, conforme abaixo.

Sheets("Plan2").Cells(c + 1, 13).Resize(k - 1).Value = n.Value
Sheets("Plan2").Cells(c + 1, 14).Resize(k - 1).Value = _


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
Agora, osvaldomp disse:

Acrescente as partes em vermelho, conforme abaixo.

Sheets("Plan2").Cells(c + 1, 13).Resize(k - 1).Value = n.Value
Sheets("Plan2").Cells(c + 1, 14).Resize(k - 1).Value = _

ok, valeu

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

Me parece que você editou o seu post e acrescentou que quer o resultado nas colunas A e B, então substitua conforme abaixo.

Sheets("Plan2").Cells(c + 1, 1).Resize(k - 1).Value = n.Value
Sheets("Plan2").Cells(c + 1, 2).Resize(k - 1).Value = _


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

×
×
  • Criar Novo...