Getting 6 columns instead of 5 after transposing rows

Question

Edit: I can see how my post can be confusing, it was hard for me to describe what I'm trying to do.

I want the end result of the transpose to look like it does in the screen shot. The issue is why I'm getting 6 columns when I only want 5. The values in Col D:H are supposed to be the beginning and end. But instead they are shifted to the right and Col C has values I do not want there. As well as the issue of why the second row appears to be shifted down.

More detail: The first value in each group of 5 cells is a serial number. The next for cells are measurements. I need these groups of 5 to stay in their original order. But right now the groups are going from high serial number to low serial number and I need it to be the reverse of that.

Original Post: I am trying to get each 5 rows to transpose into their own single row in 5 columns but in reverse and staying in the descending order. The first row in every 5 rows in Column A is a serial number, as you can see the numbers descend. I need to keep the 5 rows together but reverse the serial numbers.

I am close but the values in column D are sequential serial numbers that are supposed to be in column C. And the values in column C seem to be the last value in a set of 5 rows. Can someone please help me.

My code:
Dim bottomB As Integer
bottomB = Range("A" & Rows.Count).End(xlUp).Row
Dim TR As Long
For TR = bottomB To 2 Step -5
Range(Cells(TR, "A"), Cells(TR + 5, "A")).Copy
Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next TR

Answer 1

I have now revised your code to do what I think you intend it to do. The main difference is between the definition of the range to copy. Of course, if you start from row 1 and add 5 you end up at row 6 which is the start of the next group, not the end of the current one. Therefore the correct formula is to define the range as rows 1 to 1+4. And if you start with the last row and add 4 cells below it you will have only a single value in that range because all cells below the last one are blank. Therefore you must start at the cell which is 4 cells above the last one.

' 139
Dim bottomB As Integer
Dim TR As Long

bottomB = Range("A" & Rows.Count).End(xlUp).Row - 4
For TR = bottomB To 2 Step -5
    Range(Cells(TR, "A"), Cells(TR + 4, "A")).Copy
    Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next TR

I think my adjustments cure the faults you have been complaining about. However, I point out that the code is excessively reliant upon the last row in the column being a fourth measurement of a set. Any deviation at that point must cause failure for the entire operation.

Please consider adding Application.ScreenUpdating = False before the loop and setting the property to True again thereafter. That will greatly speed up the operation and avoid any flicker on the screen as data change quickly.

With all that was said done your code would look like this:-

Sub TransposeRows_2()
    ' 139
    Dim bottomB As Long
    Dim TR As Long
    
    bottomB = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For TR = (bottomB - 4) To 2 Step -5
        Range(Cells(TR, "A"), Cells(TR + 4, "A")).Copy
        Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Next TR
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub