Alternative Codes simplified codes using [ ] shorthand


One using a Loop to Transpose
Code:
Function FuR_AlanShtHdshg(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
1   Let rngIn.Name = "snRgNme"
370 Dim rwsS() As String: Let rwsS() = Strings$.Split(Replace(Strings$.Join(Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")"), "|"), "|" & FoutRw & "", "", 1, -1), "|", -1)
390 Dim rwsT() As String: ReDim rwsT(0 To (UBound(rwsS())), 1 To 1)
400 Dim Cnt As Long: For Cnt = 0 To UBound(rwsS()): Let rwsT(Cnt, 1) = rwsS(Cnt): Next Cnt
480 Let FuR_AlanShtHdshg = Application.Index(Cells, rwsT(), [column(snRgNme)])
End Function

_...............................

One using .Dot Transpose
Code:
Function FuR_AlanShtHdDotTshg(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
1   Let rngIn.Name = "snRgNme"
550 Let FuR_AlanShtHdDotTshg = Application.Index(Cells, Application.Transpose(Strings$.Split(Replace(Strings$.Join(Evaluate("column(" & [CL(MIN(Row(snRgNme)))] & ":" & [CL(MIN(Row(snRgNme)) + rows(snRgNme) - 1)] & ")"), "|"), "|" & FoutRw & "", "", 1, -1), "|", -1)), [column(snRgNme)])
End Function

_................................

Calling Code once again

' To Test Function, Type some arbitrary values in range A1:E10, step through Main Test Code in F8 Debug Mode in VB Editor, and examine Worksheet, Immediate Window ( Ctrl+G when in VB Editor ), hover over variables in the VB Editor Window with mouse cursor, set watches on variables ( Highlight any occurrence of a variable in the VB Editor and Hit Shift+F9 ) , etc.. and then you should expected the required Output to be pasted out starting Top Left at cell M17
Code:
Sub Alan()
 Dim sp() As Variant
    'Dim DataArr() As Variant: Let DataArr() = Range("A1:E10").Value
' Let sp() = FuR_Alan(Range("A1:E10"), 5)
' Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
' Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()
 
' Let sp() = FuRSHg(Range("A1:E10"), 5)
' Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
' Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()
 
' Let sp() = FuRSHgDotT(Range("A1:E10"), 5)
' Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
' Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()

 Let sp() = FuR_AlanShtHd(Range("A1:E10"), 5)
 Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
 Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()

 Let sp() = FuR_AlanShtHdshg(Range("A1:E10"), 5)
 Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
 Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()
 
 Let sp() = FuR_AlanShtHdDotTshg(Range("A1:E10"), 5)
 Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)).ClearContents
 Let Range("M17").Resize(UBound(sp(), 1), UBound(sp(), 2)) = sp()
 
End Sub
_........

And again required Column Letter Function
Code:
Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do
     Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL
     Let lclm = (lclm - (1)) \ 26
    Loop While lclm > 0
End Function