Proposal :
Option Explicit
Sub wtmayoza()
Dim wbo As Worksheet, wbn As Worksheet
Dim lastcol As Long 'last colum to handle in original sheet
Dim i As Long
Dim origline As Long, newline As Long
Set wbo = ThisWorkbook.Sheets("orig")
Set wbn = ThisWorkbook.Sheets("new")
origline = 2
newline = 2
lastcol = 2
Do While wbo.Cells(1, lastcol + 1) <> ""
lastcol = lastcol + 1
Loop 'Do While wbo.Cells(1, totcol + 1) <> ""
Do While wbo.Cells(origline, 1) <> ""
For i = 3 To lastcol
wbn.Cells(newline, 1) = wbo.Cells(origline, 2)
wbn.Cells(newline, 2) = wbo.Cells(origline, 1)
wbn.Cells(newline, 3) = wbo.Cells(origline, i)
wbn.Cells(newline, 4) = wbo.Cells(1, i)
newline = newline + 1
Next i
origline = origline + 1
Loop 'Do While wbo.Cells(origline, 1) <> ""
End Sub
Thanks