Isso pressupõe que os dados originais estão em Folha1 e a saída será colocada em Folha2 .
Como executar esta macro curta:
Sub ReOrganizer()
Dim N As Long, nCols As Long
Dim i As Long, j As Long, k As Long
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
N = s1.Cells(Rows.Count, 1).End(xlUp).Row
nCols = 5
k = 2
For i = 2 To N
Item = s1.Cells(i, 1)
For j = 2 To nCols
If s1.Cells(i, j) <> "" Then
s2.Cells(k, 1) = Item
s2.Cells(k, 2) = s1.Cells(i, j)
k = k + 1
End If
Next j
Next i
End Sub
irá recolher dados como este em Folha1 :
eproduzirissoemFolha2: