Hi , I have a similar problem relating to transposing rows to columns wrt to the above.
I applied the VBA code i could only get 1 column instead if 3 columns.

My data table format is like below :
CTR   22/2/22
CTR   28/2/22
CTR   31/3/22
I have over 5000 number of rows to deal with.
I want to able to view as below:

CTR   22/2/22   28/2/22   31/3/22 for various documents
Please can any one help out here?
Im new to excel VBA.

The current VBA code applied is :
<pre>ub Macro1()
    Dim prevRow As Integer
    Dim currentRow As Integer
    Dim strTemp As String
    Dim pasteColumnIdx As Integer
    
    prevRow = 2 '1st row is for column heading
    currentRow = prevRow + 1 'starts from row 3
    pasteColumnIdx = 8
    
    Do While Cells(currentRow, 1).Text <> ""
    
        If Cells(prevRow, 1).Text = Cells(currentRow, 1).Text Then
            Range(Cells(currentRow, 4), Cells(currentRow, 7)).Select
            Selection.Cut
            Range(Cells(prevRow, pasteColumnIdx), Cells(prevRow, pasteColumnIdx)).Select
            pasteColumnIdx = pasteColumnIdx + 4
            ActiveSheet.Paste
            strTemp = CStr(currentRow) + ":" + CStr(currentRow)
            Rows(strTemp).Select
            Selection.Delete Shift:=xlUp
            'currentRow = currentRow + 1
        Else
            prevRow = prevRow + 1
            currentRow = currentRow + 1
            pasteColumnIdx = 8
        End If

ub Macro1()
    Dim prevRow As Integer
    Dim currentRow As Integer
    Dim strTemp As String
    Dim pasteColumnIdx As Integer
    
    prevRow = 2 '1st row is for column heading
    currentRow = prevRow + 1 'starts from row 3
    pasteColumnIdx = 8
    
    Do While Cells(currentRow, 1).Text <> ""
    
        If Cells(prevRow, 1).Text = Cells(currentRow, 1).Text Then
            Range(Cells(currentRow, 4), Cells(currentRow, 7)).Select
            Selection.Cut
            Range(Cells(prevRow, pasteColumnIdx), Cells(prevRow, pasteColumnIdx)).Select
            pasteColumnIdx = pasteColumnIdx + 4
            ActiveSheet.Paste
            strTemp = CStr(currentRow) + ":" + CStr(currentRow)
            Rows(strTemp).Select
            Selection.Delete Shift:=xlUp
            'currentRow = currentRow + 1
        Else
            prevRow = prevRow + 1
            currentRow = currentRow + 1
            pasteColumnIdx = 8
        End If