vba to move data from a row to a column

[LalitPandey87]

Here you go:

Change constant variable values accordingly (Highlighted with red color)

Sub Lalit_Test()

    Dim varData()               As Variant
    Dim varFinalData()          As Variant
    Dim lngTotalDataCell        As Long
    Dim lngLoop                 As Long
    Dim lngLoop1                As Long
    Dim lngCount                As Long
    
    Const strDataRange          As String = "$A$6:$E$9"
    Const strDataShtName        As String = "Sheet1"
    Const strOutDataCell        As String = "$K$13"
    
    With ThisWorkbook.Worksheets(strDataShtName)
        .Range(strOutDataCell).Resize(.Rows.Count - .Range(strOutDataCell).Row + 1, 2).ClearContents
        varData = .Range(strDataRange).Value
        lngTotalDataCell = WorksheetFunction.CountA(.Range(strDataRange)) - .Range(strDataRange).Rows.Count
        ReDim varFinalData(1 To lngTotalDataCell, 1 To 2)
        lngCount = 0
        For lngLoop = LBound(varData) To UBound(varData)
            varFinalData(lngCount + 1, 1) = varData(lngLoop, LBound(varData))
            For lngLoop1 = LBound(varData) + 1 To UBound(varData, 2)
                If LenB(Trim(varData(lngLoop, lngLoop1))) Then
                    lngCount = lngCount + 1
                    varFinalData(lngCount, 2) = varData(lngLoop, lngLoop1)
                End If
            Next lngLoop1
        Next lngLoop
        If lngCount Then
            .Range(strOutDataCell).Resize(UBound(varFinalData), UBound(varFinalData, 2)).Value = varFinalData
        End If
    End With
    
    Erase varData
    Erase varFinalData
    lngTotalDataCell = Empty
    lngLoop = Empty
    lngLoop1 = Empty
    lngCount = Empty

End Sub