Este fórum está sendo desativado

[paulocneves]

Prezados, boa tarde.

Por favor, preciso fazer com que o macro extraia todos os valores separados por vírgula e adicione na linha abaixo. Como eu consigo fazer isso?

Segue imagens de como está:



E como eu queria que ficasse:





Muito obrigado galera!!

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub RearranjaDados()
 Dim nfe As Long, pv As Long, v As Variant, i As Long
  nfe = 2
  Do
   If Cells(nfe, 2) = "" Then Exit Sub
   pv = Len(Cells(nfe, 2)) - Len(Replace(Cells(nfe, 2), ";", ""))
    If pv > 0 Then
     Rows(nfe + 1 & ":" & nfe + pv).Insert
     Cells(nfe + 1, 1).Resize(pv).Value = Cells(nfe, 1)
     v = Split(Cells(nfe, 2), ";")
      For i = LBound(v) To UBound(v)
       Cells(nfe + i, 2) = v(i)
      Next i
     nfe = nfe + pv
    End If
   nfe = nfe + 1
  Loop
End Sub

obs.
1. considerei que a tabela está nas colunas A:B a partir da linha 1
2. o resultado do código será diferente do seu em algumas células (me parece que o seu resultado apresenta algumas inconsistências)