Sub Test()
Dim r As Range
Dim sh As Worksheet, WS1 As Worksheet
Dim x As Long, y As Long, i As Long, j As Long, c As Long
Set WS1 = ActiveSheet
Set r = Selection
c = r.Cells(1, 1).Column + 1
x = r.Rows.Count
y = r.Columns.Count
Set sh = Sheets.Add(after:=Sheets(Sheets.Count))
sh.Range("A1:D1") = Array("C1", "C2", "C3", "C4")
For i = 0 To x - 1
For j = 0 To y - 2
sh.Cells(2, 1).Offset(j * x).Resize(x) = WS1.Cells(2, c + j)
sh.Cells(2, 2).Offset(j * x).Resize(x) = WS1.Cells(2, c + j)
sh.Cells(2, 3).Offset(j * x).Resize(x) = r.Columns(1).Value
sh.Cells(2, 4).Offset(j * x).Resize(x) = r.Columns(2 + j).Value
Next j
Next i
End Sub