vba to move data from a row to a column

[RobertCordrey]

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.

[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.

[RobertCordrey]

Thanks for the willingness to assist a newbie!

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.

[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