Hi,
See the attached which uses the following macro.
Sub TransposeData()
Dim lRows As Long, lcolumns As Long, x As Long
Application.ScreenUpdating = False
lRows = Sheets("Input").Range("A1").CurrentRegion.Rows.Count - 1
lcolumns = Sheets("Input").Range("A1").CurrentRegion.Columns.Count - 4
Sheets("Input").Range("A1:D1").Copy Destination:=Sheets("Output").Range("A1")
Sheets("Output").Cells(1, 5) = "Indicator"
Sheets("Output").Cells(1, 6) = "Value"
For x = 1 To lcolumns
Sheets("Input").Range("A1").CurrentRegion.Offset(1, 0).Resize(lRows, 4).Copy
Sheets("Output").Range("A2").Cells(x * lRows - lRows + 1, 1).PasteSpecial (xlPasteAll)
Range(Sheets("Output").Range("E2").Cells(x * lRows - lRows + 1, 1), Sheets("Output").Range("E2").Cells(x * lRows, 1)) = Sheets("Input").Cells(1, x + 4)
Sheets("Input").Range("A1").CurrentRegion.Offset(1, x + 3).Resize(lRows, 1).Copy
Sheets("Output").Range("F2").Cells(x * lRows - lRows + 1, 1).PasteSpecial (xlPasteAll)
Next x
End Sub
Bookmarks