Transpose rows based on specific text

[tezza]

Hi all

I'm trying to speed up the transpose process. When I copy an order form from online it pastes it all into Col A but I need to make it easier to read as I already have the next stages in place. The problem is the site changes from time to time and I have to redo the sheet.

The common factor in all of the items listed is where it says +Add to basket and that needs to be the final column before start a new row.

Have a look below to see what I'm trying to achieve:

Obviously transpose works but I can't keep redoing around 250 items each time the site decides to change something so I'm looking for a VBA fix to automate it for me if possible please.

Excel Workbook
	A
2	CleanWorks
3	CleanWorks Light Weight Hygiene Cloth Blue
4
5	Code: 001291
6	Be the first to rate this product
7	4.50 Pack of 100 (ex. VAT)
8
9	5.40 inc. VAT
10	Size 51 x 36cm, Colour Blue
11	-
12	1
13	+Add to basket
14
15	CleanWorks
16	CleanWorks Light Weight Hygiene Cloth Red
17
18	Code: 001293
19	Be the first to rate this product
20	4.50 Pack of 100 (ex. VAT)
21
22	5.40 inc. VAT
23	Size 51 x 36cm, Colour Red
24	-
25	1
26	+Add to basket
27
28	CleanWorks
29	CleanWorks Light Weight Hygiene Cloth Yellow
30
31	Code: 001294
32	Be the first to rate this product
33	4.50 Pack of 100 (ex. VAT)
34
35	5.40 inc. VAT
36	Size 51 x 36cm, Colour Yellow
37	-
38	1
39	+Add to basket
Copied Data

Excel Workbook
	C	D	E	F	G	H	I	J	K	L	M	N
2	CleanWorks	CleanWorks Light Weight Hygiene Cloth Blue		Code: 001291	Be the first to rate this product	4.50 Pack of 100 (ex. VAT)	0	5.40 inc. VAT	Size 51 x 36cm, Colour Blue	-	1	+Add to basket
3	CleanWorks	CleanWorks Light Weight Hygiene Cloth Red		Code: 001293	Be the first to rate this product	4.50 Pack of 100 (ex. VAT)	0	5.40 inc. VAT	Size 51 x 36cm, Colour Red	-	1	+Add to basket
4	CleanWorks	CleanWorks Light Weight Hygiene Cloth Yellow		Code: 001294	Be the first to rate this product	4.50 Pack of 100 (ex. VAT)	0	5.40 inc. VAT	Size 51 x 36cm, Colour Yellow	-	1	+Add to basket
Sorted Data

 

[DanteAmor]

The following may be an option. Transpose every 13 data.
The result will be on sheet2

Change data in red by your information

Sub Transpose_rows()
  Dim sh1 As Worksheet, i As Long
  Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
  Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Cells.ClearContents
  For i = 2 To sh1.Range("A" & Rows.Count).End(xlUp).Row Step 13
    Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Range("A" & Rows.Count).End(xlUp)(2).Resize(1, 13).Value = Application.Transpose(sh1.Range("A" & i).Resize(13, 1).Value)
  Next
End Sub

 

[igold]

How about this. I output to the same sheet starting in Cell C2 (last line of code) as you did not indicate anything different. Additionally, this will work only if the format of the original data does not change. Meaning that "+Add to basket" appears in a row number that is a multiple of 13.

Sub tpose()


    Dim arr, tpose
    Dim lRow As Long, x As Long, c As Long, d As Long


    c = 1: d = 1
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A1:A" & lRow)
    ReDim tpose(1 To UBound(arr, 1), 1 To 13)
    For x = 1 To UBound(arr)
        tpose(d, c) = arr(x, 1)
        c = c + 1
        If c = 14 Then
            c = 1
            d = d + 1
        End If
    Next
    Range("C2").Resize(UBound(tpose, 1), UBound(tpose, 2)) = tpose


End Sub