Experimente:

Sub OrganizaDados()
 Dim r As Range, i As Long
 For Each r In Sheets("Sheet1").Range("B4:B" & Sheets("Sheet1").Cells(Rows.Count, 2).End(3).Row)
  With Sheets("Sheet2")
   For i = 1 To 3
    If r.Offset(, i).Value <> 0 Then
     .Cells(Rows.Count, 3).End(3)(2) = r.Value
     .Cells(Rows.Count, 4).End(3)(2) = Sheets("Sheet1").Cells(3, i + 2)
     .Cells(Rows.Count, 5).End(3)(2) = r.Offset(, i).Value
    End If
   Next i
  End With
 Next r
End Sub

Obrigado.

A parte das linhas está ok. No entanto, não está a colocar os valores à frente das linhas criadas.

Cumprimentos,

O código que eu sugeri, aplicado no arquivo que você disponibilizou retorna o resultado abaixo na planilha Sheet2, que é igual ao resultado que você colocou como desejado. O que exatamente estaria faltando?

...C............D..............E
John........Product A.....100
John........Product C.....200
Peter........Product B.....100
Peter........Product C.....200
Walter......Product A.....500
Walter......Product B.....600
Walter......Product C.....700

Comigo não está funcionando.

Veja anexo pff.

Obrigado.

Boa tarde.
Segue minha contribuição.
fiz com o power query e deixei apenas uma macro simples de atualização.
Veja se te ajuda.

Problemas com células mescladas.

Na planilha Sheet2 coloque cabeçalhos de colunas na linha 3 (abaixo das células mescladas que estão na linha 2). Exemplo: C3=nome, D3=prod, E3=val.

Ou exclua a linha 2 que está com células mescladas (sugestão - nunca mescle células no Excel) e se quiser coloque cabeçalhos de colunas na linha 1.

Funcionou.

Obrigado pela ajuda.

Resolvido.

Cumprimentos,