Sub Test()
    Call TransposeBack(Sheet1.Range("A3:D10"), Sheet1.Range("I1"))
End Sub
 
Sub TransposeBack(rngData As Range, rngTarget As Range)
    Dim rngHeader       As Range
    Dim rngId           As Range
    Dim rngCell         As Range
    Dim rngDest         As Range
    Dim lngRept         As Long
 
    Set rngDest = rngTarget.Offset(1)
 
    With rngData
        Set rngHeader = Intersect(.Rows(1), .Rows(1).Offset(, 1))
        Set rngId = Intersect(.Columns(1), .Columns(1).Offset(1))
    End With
    lngRept = rngHeader.Cells.Count
 
    rngTarget.Resize(, 3).Value = Array("Id", "Date", "Values")
 
    For Each rngCell In rngId.Cells
        With rngDest.Resize(lngRept)
            .Value = rngCell.Value
            .Offset(, 1).Value = Application.Transpose(rngHeader)
            .Offset(, 1).NumberFormat = rngHeader.Cells(1).NumberFormat
            Set rngDest = .Offset(lngRept)
        End With
    Next rngCell
 
    With rngTarget
        .Offset(1, 2).Value = "=VLOOKUP(" & .Offset(1).Address(False, , , True) & "," & rngData.Address(, , , True) & ",MATCH(" & rngTarget.Offset(1, 1).Address(False, , , True) & "," & rngData.Rows(1).Address(, , , True) & ",0),FALSE)"
        .Offset(1, 2).AutoFill Destination:=.Offset(1, 2).Resize(rngId.Cells.Count * rngHeader.Cells.Count)
        .Offset(1, 2).Resize(rngId.Cells.Count * rngHeader.Cells.Count).Value = .Offset(1, 2).Resize(rngId.Cells.Count * rngHeader.Cells.Count).Value
    End With
 
    Set rngHeader = Nothing
    Set rngId = Nothing
    Set rngCell = Nothing
    Set rngDest = Nothing
End Sub