Este fórum está sendo desativado

[Edson583513]

Pessoal, boa tarde, tenho uma planilha com 90000 mil linhas e com a seguintes informações:
Código nome Empresa tipo de licença Data de inicio da Licença Data fim da Licença avos da licença

onde se repetem alguns códigos funcionais e com licenças em anos diferentes, mas como estão verticalmente eu preciso colocar na horizontal da seguinte forma:

Código nome Empresa tipo da licença inicio da licença fim da licença avos da licença tipo da licença inicio da licença fim da licença avos da licença

E assim por diante.

Espero que tenha sido claro.

Se alguém puder me ajudar fico muito agradecido.

Obrigado

[Queilasp]

a sua planilha esta na vertical e vc precisa que ela esteja na horizontal é isso????

se for isso você pode utilizar um recurso do excel de transpor!

como se utiliza isso ???
Seleciona todo o conteúdo - depois você copia
e na hora de locar clique no botão colar especial é o ultimo botão da opção colar

[alexandrevba]

Bom dia!!!

Como eu não sei como está posicionados e como vai ficar (antes e depois), uma Tabela Dinâmica ou a formula =TRANSPOR( ou recurso transpor
https://support.office.com/pt-br/articl ... f862209744
https://support.office.com/pt-br/articl ... 6dfac76027

Att

[Edson583513]

Bom dia !!! Tentei mas não funcionou, tentei até colocar uma formula, mas não deu certo, estou colocando uma planilha de exemplos com duas abas, original e como deve ficar.
Lembrando que os códigos seriam os mesmos funcionários com varias licenças e que devem ficar na horizontal.

Muito Obrigado!!!

[alexandrevba]

Boa tarde!!

Segue uma rotina de um dos maiores nome do excel.

Código: Selecionar todos

Sub Consolidate()
'Fonte:http://sites.madrocketscientist.com/jerrybeaucaires-excelassistant/text-functions/column-sets-to-rows
'JBeaucaire  (9/18/2009)
'Columnar data is Sorted/Matched by column A values, merge all other cells into row format
Dim LastRow As Long, NextCol As Long
Dim LastCol As Long, Rw As Long, Cnt As Long
Dim delRNG As Range
Application.ScreenUpdating = False

'Sort data
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    
'Seed the delete range
    Set delRNG = Range("A" & LastRow + 10)
    
'Group matching names
    For Rw = LastRow To 2 Step -1
        If Cells(Rw, "A").Value = Cells(Rw - 1, "A").Value Then
            Range(Cells(Rw, "B"), Cells(Rw, Columns.Count).End(xlToLeft)).Copy _
                Cells(Rw - 1, Columns.Count).End(xlToLeft).Offset(0, 1)
            Set delRNG = Union(delRNG, Range("A" & Rw))
        End If
    Next Rw

'Delete unneeded rows all at once
    delRNG.EntireRow.Delete (xlShiftUp)
    Set delRNG = Nothing

'Add titles
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 1
    LastCol = Cells(1, 1).CurrentRegion.Columns.Count
    Range("B1", Cells(1, NextCol - 1)).Copy Range(Cells(1, NextCol), Cells(1, LastCol))

Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Selecione a guia Original, execute a rotina.

Att

[Edson583513]

Muito Obrigado!!! Funcionou Perfeitamente.