VBA Transpose Cells in a range

[decadence]

Hi, Is it possible to transpose a group of cells then move to the next group of cells, Can someone help with tis please

Example:

From This

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]This1
[/TD]
[TD]This2
[/TD]
[/TR]
[TR]
[TD]This3
[/TD]
[TD]This4
[/TD]
[/TR]
[TR]
[TD]This5
[/TD]
[TD]This6
[/TD]
[/TR]
[TR]
[TD]That1
[/TD]
[TD]That2
[/TD]
[/TR]
[TR]
[TD]That3
[/TD]
[TD]That4
[/TD]
[/TR]
[TR]
[TD]That5
[/TD]
[TD]That6
[/TD]
[/TR]
[TR]
[TD]Something1
[/TD]
[TD]Something2
[/TD]
[/TR]
[TR]
[TD]Something3
[/TD]
[TD]Something4
[/TD]
[/TR]
[TR]
[TD]Something5
[/TD]
[TD]Something6
[/TD]
[/TR]
[TR]
[TD]Nothing1
[/TD]
[TD]Nothing2
[/TD]
[/TR]
[TR]
[TD]Nothing3
[/TD]
[TD]Nothing4
[/TD]
[/TR]
[TR]
[TD]Nothing5
[/TD]
[TD]Nothing6
[/TD]
[/TR]
</tbody>[/TABLE]


To This

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]This1
[/TD]
[TD]This2
[/TD]
[TD]This3
[/TD]
[TD]This4
[/TD]
[TD]Ths5
[/TD]
[TD]This6
[/TD]
[/TR]
[TR]
[TD]That1
[/TD]
[TD]That2
[/TD]
[TD]That3
[/TD]
[TD]That4
[/TD]
[TD]That5
[/TD]
[TD]That6
[/TD]
[/TR]
[TR]
[TD]Something1
[/TD]
[TD]Something2
[/TD]
[TD]Something3
[/TD]
[TD]Something4
[/TD]
[TD]Something5
[/TD]
[TD]Something6
[/TD]
[/TR]
[TR]
[TD]Nothing1
[/TD]
[TD]Nothing2
[/TD]
[TD]Nothing3
[/TD]
[TD]Nothing4
[/TD]
[TD]Nothing5
[/TD]
[TD]Nothing6
[/TD]
[/TR]
</tbody>[/TABLE]

 

[Joe4]

Are there always exactly 6 items for each grouping?
If not, are the names to move to the line always EXACTLY the same, or do they just contain a similar prefix?
If they are not exactly the same, please provide some real examples, so we can see exactly what this data we are working with looks like, so we can ensure that we groups them properly.

 

[decadence]

The original data will always be in columns C and D but will be varied in number of rows, yes it will always be in groups of 6 however the data is varied by numbers and text in each cell.

Essentially what I am looking to do is use cell value rather than specific text but want to put the first 6 cells c1,d1,c2,d2,c3,d3 from c1 to h1 then move to the next 6 cells c4,d4,c5,d5,c6,d6 and put those cells on the next row from c2 to h2 and so forth

 

[Joe4]

Try this (note it will take the data from one sheet and paste it to another, so be sure to update the sheet names at the top of the code to match what you have):

Sub MyTranspose()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lr As Long
    Dim r As Long
    Dim nr As Long
    Dim i As Long
    
'   Set source worksheet
    Set ws1 = Sheets("Sheet1")
'   Set destination worksheet
    Set ws2 = Sheets("Sheet2")
    
    Application.ScreenUpdating = False
    
'   Find last row on source sheet with an entry in column C
    lr = ws1.Cells(Rows.Count, "C").End(xlUp).Row
    
'   Loop through all rows
    For r = 1 To lr Step 3
'       Calculate row on destination sheet to paste to
        nr = Int(r / 3) + 1
'       Copy over first three rows of data
        For i = 0 To 2
            ws1.Range(Cells(r + i, "C"), Cells(r + i, "D")).Copy ws2.Cells(nr, (i * 2) + 3)
        Next i
    Next r
    
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
    
End Sub

 

[decadence]

Hi Joe4 This works perfectly, Thank you

 

[Joe4]

You are welcome.