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
DON'T MISS
Thanks