Este fórum está sendo desativado

[gabiwol]

Boa noite,

Tentei de todas as formas fazer pelo Excel mas devido a grande demanda de dados e a não possibilidade de fazer manualmente, creio que isso seja papo de VBA, na qual estou estudando ainda (sou nova no assunto)

Preciso transpor as linhas em coluna porém tem algumas condições:
- Se o tipo de item for "Serviço" preciso que insira 5 linhas de acordo com uma tabela específica para ele
- Se for qualquer outro tipo de item vai ser inserido 4 linhas com uma tabela fixa para eles
- Essas linhas que serão inseridas eu vou precisar preencher elas de acordo com a lista fixa (serviço e para os demais itens)

No anexo tem os dados atuais e como preciso que fique para melhor visualização, queria saber se há uma possibilidade de fazer isto e se puderem informar as "formulas" ideais, eu agradeço.

Transpor.xlsx

[Foxtri]

Boa Tarde gabiwol.
Veja se o que foi feito atende a sua necessidade.
Até
Foxtri

[osvaldomp]

Experimente o código abaixo. Funciona com qualquer quantidade de itens.
Para utilizar em outro arquivo basta colar uma cópia do código em um módulo comum do arquivo desejado. Para rodar o código utilize um botão, como no arquivo anexado, ou atalho de teclado ou Alt+F8.

Código: Selecionar todos

Sub RearranjaDados()
 Dim ci As Range, ws As Worksheet, LR As Long
  Set ws = ActiveSheet
  Sheets.Add
  [A1:D1] = Array("COD ITEM", "GERAL/SERVIÇ", "CL", "LC")
  For Each ci In ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(3).Row)
   LR = Cells(Rows.Count, 1).End(3).Row
   If ci.Offset(, 4).Value = "SERVIÇO" Then
    Cells(LR + 1, 1).Resize(5).Value = ci.Value
    Cells(LR + 1, 2).Resize(5).Value = ws.[L2:L6].Value
    Cells(LR + 1, 3).Resize(5).Value = Application.Transpose(Array("NCM", "NCM 01", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4).Resize(5).Value = Application.Transpose(ci.Offset(, 1).Resize(, 5).Value)
   Else
    Cells(LR + 1, 1).Resize(4).Value = ci.Value
    Cells(LR + 1, 2).Resize(4).Value = ws.[J2:J5].Value
    Cells(LR + 1, 3).Resize(4).Value = Application.Transpose(Array("NCM", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4) = ci.Offset(, 1).Value
    Cells(LR + 2, 4).Resize(3).Value = Application.Transpose(ci.Offset(, 3).Resize(, 3).Value)
   End If
  Next ci
  Columns("A:D").AutoFit
End Sub

[gabiwol]

Boa Tarde gabiwol.
Veja se o que foi feito atende a sua necessidade.
Até
Foxtri

Excelente, funcionou exatamente como eu precisava.
Obrigado! Me salvou e ainda vai me ajudar a compreender/estudar.

[gabiwol]

Experimente o código abaixo. Funciona com qualquer quantidade de itens.
Para utilizar em outro arquivo basta colar uma cópia do código em um módulo comum do arquivo desejado. Para rodar o código utilize um botão, como no arquivo anexado, ou atalho de teclado ou Alt+F8.

Código: Selecionar todos

Sub RearranjaDados()
 Dim ci As Range, ws As Worksheet, LR As Long
  Set ws = ActiveSheet
  Sheets.Add
  [A1:D1] = Array("COD ITEM", "GERAL/SERVIÇ", "CL", "LC")
  For Each ci In ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(3).Row)
   LR = Cells(Rows.Count, 1).End(3).Row
   If ci.Offset(, 4).Value = "SERVIÇO" Then
    Cells(LR + 1, 1).Resize(5).Value = ci.Value
    Cells(LR + 1, 2).Resize(5).Value = ws.[L2:L6].Value
    Cells(LR + 1, 3).Resize(5).Value = Application.Transpose(Array("NCM", "NCM 01", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4).Resize(5).Value = Application.Transpose(ci.Offset(, 1).Resize(, 5).Value)
   Else
    Cells(LR + 1, 1).Resize(4).Value = ci.Value
    Cells(LR + 1, 2).Resize(4).Value = ws.[J2:J5].Value
    Cells(LR + 1, 3).Resize(4).Value = Application.Transpose(Array("NCM", "CATALOGO 01", "TIPO", "NOME ITEM"))
    Cells(LR + 1, 4) = ci.Offset(, 1).Value
    Cells(LR + 2, 4).Resize(3).Value = Application.Transpose(ci.Offset(, 3).Resize(, 3).Value)
   End If
  Next ci
  Columns("A:D").AutoFit
End Sub

Lhe agradeço também pela ajuda, está funcionando perfeitamente!