Ir para conteúdo
  • Cadastre-se

A partir do dia 19/11/2018, o foco do Fórum do BABOO é apenas Windows e Segurança Digital conforme informado no início de 2018.
As áreas que não têm relação com esses dois assuntos foram arquivadas e seus tópicos estão disponíveis para consulta na área Tópicos Antigos.

Conheça as novidades de 2019 para o BABOO e Fórum do BABOO

Vinicius Guarino

Macro passar linhas para coluna

Mensagem Recomendada

Pessoal, boa tarde!
Gostaria muito de uma ajuda, ou alguma explicação.

Tenho uma planilha em que ela vem todaaa em linhas, gostaria de criar uma macro que ela viesse toda em coluna na plan2. A planilha que vem em linhas tem uma rotina que já ajuda.

Modo que ela vem na Plan1 Ex:

Coluna A
Razão
casa
Processo
1234
Data
12/08/2015
qqqqqqqqqqqqqq
Razão
loja
Processo
5478
Data
12/07/2016
eeeeeeeeeeeeee
Razão
janela
Processo
9666
Data
19/07/2019
rrrrrrrrrrrrrrrrrrrr
Gostaria que ela viesse da forma correta na Plan2

Exemplo forma correta:
Razão     Processo         Data               
casa        1234                12/08/2015              qqqqqqqqqqqqqqqq
loja          478                  12/07/2016               eeeeeeeeeeeeeeee
janela         9666              19/07/2019              rrrrrrrrrrrrrrrrrrrrrr

Alguém teria algum trabalho parecido ou que possa me ajudar?

Obrigado!

Planilha em Anexo

Teste.zip

Compartilhar este post


Link para o post
Compartilhar em outros sites

Experimente:

Sub OrganizaDados()
 Dim LR As Long, k As Long
  Application.ScreenUpdating = False
  ActiveSheet.AutoFilterMode = False
  LR = Cells(Rows.Count, 1).End(3).Row
  Range("B1:B" & LR).FormulaLocal = "=SE(CONT.NÚM(PESQUISAR({""Data:""\""Demanda:""\""Processo:""\""Razão:""};A1));1;"""")"
  Range("A1:B" & LR).AutoFilter 2, ""
  Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).Copy Sheets("Plan2").[K1]
   With Sheets("
Plan2")
    .Columns("A:E") = ""
    .[A1].Resize(, 4).Value = [{"Razão:","Processo:","Demanda:", "Data:"}]
    LR = .Cells(Rows.Count, 11).End(3).Row
    For k = 1 To LR - 4 Step 5
     .Cells(Rows.Count, 1).End(3)(2).Resize(, 5).Value = Application.Transpose(.Cells(k, 11).Resize(5).Value)
    Next k
    .Columns(11) = ""
   End With
  ActiveSheet.AutoFilterMode = False
  Columns(2) = ""
  Application.ScreenUpdating = True
End Sub

obs. o resultado será colocado na Plan2 , altere o nome da planilha se necessário

 


 

Osvaldo

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

×