Página 1 de 1

EXTRAIR VALOR DA CÉLULA E REPLICAR NA LINHA INFERIOR

Enviado: 18 Abr 2018 às 15:32
por 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á:

Imagem

E como eu queria que ficasse:

Imagem



Muito obrigado galera!!

Re: EXTRAIR VALOR DA CÉLULA E REPLICAR NA LINHA INFERIOR

Enviado: 18 Abr 2018 às 17:56
por 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)