vba to move data from a row to a column

I have a row of data with some cells that need to be moved into a column formation. For simplicity, lets say it is only 4 adjacent cells that need to be moved into a column listed under the position of the first cell . The column position of this data is always in the same location for every row. As an example, I would receive this .... 123456,123456,123456,123456 and the data would need to be moved into a column so that it looks like this ....
123456
123456
123456
123456

I have considered using OffSet but without any success. A vba that would automatically add the necessary three blank rows below the initial row to allow the insertion of the transposed data would also be great to have. The file size for this sheet is just over 65k lines and that is a lot of right-clicking to insert lines and transpose the cells. I have struggled with this for a couple of days and have run out of others seeking help. Your assistance is greatly appreciated and thanked.

Robert, welcome to ExcelFox community.

Can you post a sample file on a file sharing site, and post the link here. It would be better to have a look at the file, and propose a solution.

Thanks for the willingness to assist a newbie!

Quote:

---

Originally Posted by Excel Fox

Robert, welcome to ExcelFox community.

Can you post a sample file on a file sharing site, and post the link here. It would be better to have a look at the file, and propose a solution.

---

Here you go:

Change constant variable values accordingly (Highlighted with red color)

Code:

---

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

---