Jump to content

Transpor varias linhas em uma só.


Recommended Posts

Bom dia Pessoal.

Estou com dificuldades e nem sei se isso é possivel.

Tenho 10 colunas e 25 linhas e gostaria de transpor ou colocar essas 25

linhas em uma unica linha todas de uma vez.

Isso é possivel?

tvgafcs.png

Mesmo que tenha numeros repetidos, não importa.

Quero fazer uma unica linha no total de 250 numeros, uma apos a outra.

Agradeço quem puder ajudar.

Link to comment
Share on other sites

A macro esta aqui 

Spoiler

Sub Transpor_varias_linhas_em_uma_so()

 

'Site cheio de Ninjas Capoeristas rsrsrrsrsr
'https://www.comoganharnaloteria.com.br/forum/

'Tópico Criado por Friaça
'Transpor várias linhas em uma só.
'https://www.comoganharnaloteria.com.br/forum/topico/33913-transpor-varias-linhas-em-uma-s%C3%B3/

 

Titulo = "Ralf Jones [Transpor várias linhas em uma só]"

 

Dim Intervalo As Range
Dim Cell_destino As Range

Set Intervalo = Application.Selection

On Error Resume Next
Set Intervalo = Application.InputBox("Selecione os intervalos a serem transformados:", Titulo, Intervalo.Address, Type:=8)
If Intervalo.Cells.Count < 2 Then
  MsgBox "Selecione no mínimo duas células!" & Chr(13) & "Procedimento Cancelado"
  Exit Sub
End If

 

Set Cell_destino = Application.InputBox("Selecione a célula de destino:", Titulo, Type:=8)

Linhas = Intervalo.Rows.Count
Colunas = Intervalo.Columns.Count

 

Application.ScreenUpdating = False

  For x = 1 To Linhas
    Intervalo.Rows(x).Copy Cell_destino
    Set Cell_destino = Cell_destino.Offset(0, Colunas + 0)
  Next
  
Application.ScreenUpdating = True

End Sub

 

  • Like 2
Link to comment
Share on other sites

Em 17/07/2020 em 15:25, Ralf Jones disse:

A macro esta aqui 

  Ocultar conteúdo

Sub Transpor_varias_linhas_em_uma_so()

 

'Site cheio de Ninjas Capoeristas rsrsrrsrsr
'https://www.comoganharnaloteria.com.br/forum/

'Tópico Criado por Friaça
'Transpor várias linhas em uma só.
'https://www.comoganharnaloteria.com.br/forum/topico/33913-transpor-varias-linhas-em-uma-s%C3%B3/

 

Titulo = "Ralf Jones [Transpor várias linhas em uma só]"

 

Dim Intervalo As Range
Dim Cell_destino As Range

Set Intervalo = Application.Selection

On Error Resume Next
Set Intervalo = Application.InputBox("Selecione os intervalos a serem transformados:", Titulo, Intervalo.Address, Type:=8)
If Intervalo.Cells.Count < 2 Then
  MsgBox "Selecione no mínimo duas células!" & Chr(13) & "Procedimento Cancelado"
  Exit Sub
End If

 

Set Cell_destino = Application.InputBox("Selecione a célula de destino:", Titulo, Type:=8)

Linhas = Intervalo.Rows.Count
Colunas = Intervalo.Columns.Count

 

Application.ScreenUpdating = False

  For x = 1 To Linhas
    Intervalo.Rows(x).Copy Cell_destino
    Set Cell_destino = Cell_destino.Offset(0, Colunas + 0)
  Next
  
Application.ScreenUpdating = True

End Sub

 

@Ralf Jones Parabéns!!! Utilizei a sua macro em um estudo e funcionou perfeitamente.

  • Thanks 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...