Fóruns
Microsoft Excel - 2...
VBA & Macros
MACRO/VBA PARA COLA...
 
Notifications
Clear all

MACRO/VBA PARA COLAR VALORES E TRANSPOR

 
VBA & Macros
Post Recente por julio_cezaro 4 anos atrás
3 Posts
2 Usuários
1 Likes
2,181 Visualizações
RSS
 julio_cezaro
(@julio_cezaro)
Posts: 4
New Member
Topic starter
 

Bom dia pessoal, tudo bem?

Preciso de uma ajuda de vocês... Será que alguém conhece um método onde eu possa colar de uma maneira mais automática números que estão todos na horizontal, colando na vertical transpondo?

Eu hoje retiro de um sistema uma base onde uma coluna vem da forma que está no arquivo (Coluna A), uma série de números que vem em uma mesma célula e todos na horizontal. Acontece que preciso transpor esses números para vertical, então o procedimento que eu faço é: primeiro separá-los todos em Texto para Colunas usando a opção Outros e colocando o sinal " | " para que fiquem todos em células distintas, depois copio toda a linha e colo especial marcando a opção Transpor para que assim fiquem todos na Vertical.

Mas como podem ver são centenas de linhas e não da pra ficar fazendo isso manualmente.

 

Preciso que eles passem para outra planilha, mas todos na vertical e não na horizontal...
O numero que está em A1, passar para A1 da Planilha 2, A2, para A2 da planilha 2... os 6 numeros que estão em A3, passar para A3, A4, A5 e A6, e assim sucessivamente.

Alguém conhece algum método que poderia auxiliar?

Desde já, obrigado.

 
Postado : 30/09/2020 11:14 am
EdsonBR
 EdsonBR
(@edsonbr)
Posts: 1056
Noble Member
 

Bom dia, @julio_cezaro. Seja bem vindo ao Planilhando!

Teste a seguinte rotina:

Sub DistribuirValores()
  Dim c As Range, v As Variant, i As Long, j As Long
  Application.ScreenUpdating = False
    For Each c In Worksheets("Planilha1").Range("A1").CurrentRegion
      If c.Value2 <> "" Then
       v = Application.Transpose(Split(c.Value2, "|"))
       i = j + 1: j = j + UBound(v)
       Worksheets("Planilha2").Range("A" & i, "A" & j).Value2 = v
      End If
    Next c
  Application.ScreenUpdating = True
End Sub

Obs.: crie a planilha "Planilha2" antes de rodar o código já que seu arquivo só tem a Planilha1 e aumente um pouco a largura da coluna A dela.

 
Postado : 30/09/2020 12:35 pm
 julio_cezaro
(@julio_cezaro)
Posts: 4
New Member
Topic starter
 

@edsonbr caracaaaa era exatamente o que eu precisava!!!! Executa imediato e traz o resultado da forma que eu preciso Edson. Muito mas muito obrigado mesmo!!! Vc não tem ideia de como ajudou!!! Grande abraço!!

 
Postado : 30/09/2020 3:03 pm
EdsonBR reacted
Forum Jump:
  Tópico Anterior
Próximo Tópico