Transpose All data until next blank cell, repeat for all rows

[Simon4s]

I have a ton of rows and it looks like the following:
Title
ID
Size
URL
Image
Price
BLANK
Title
ID
Size
URL
Image
Price
BLANK

The blank is the divider to the next set of information. I want to transpose the data so that it looks like this:

Title	ID	SIZE	URL	Image	Price
Title	ID	Size	URL	Image	Price

How can I achieve this? Thanks!

 

[maabadi]

This code Transpose Column A to Column D and Next:

Sub Transpose2()
Dim i As Long, Lr1 As Long, Lr As Long, R As String
Lr = Range("A" & Rows.Count).End(xlUp).Row
R = 1
For i = 1 To Lr
Lr1 = Range("A" & i).End(xlDown).Row
Range("A" & i & ":A" & Lr1).Copy
Range("D" & R).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
i = Lr1 + 1
R = R + 1
Next i
End Sub

 

[Simon4s]

This code Transpose Column A to Column D and Next:

Sub Transpose2()
Dim i As Long, Lr1 As Long, Lr As Long, R As String
Lr = Range("A" & Rows.Count).End(xlUp).Row
R = 1
For i = 1 To Lr
Lr1 = Range("A" & i).End(xlDown).Row
Range("A" & i & ":A" & Lr1).Copy
Range("D" & R).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
i = Lr1 + 1
R = R + 1
Next i
End Sub

Will this still work if each set of data contains a different number of rows? I forgot to mention that each set of data has between 1-6 tags.

 

[maabadi]

No problem. Try it with example file first.

 

[Peter_SSs]

A slight variation to also consider

Sub Rearrange()
  Dim rA As Range
  
  Application.ScreenUpdating = False
  For Each rA In Columns("A").SpecialCells(xlConstants).Areas
    Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, rA.Rows.Count).Value = Application.Transpose(rA.Value)
  Next rA
  Application.ScreenUpdating = True
End Sub

My sample data and results

Simon4s.xlsm
	A	B	C	D	E	F	G	H	I
1	Title 1
2	ID 1		Title 1	ID 1	Size 1	URL 1	Image 1	Price 1
3	Size 1		Title 2	ID 2	Size 2	URL 2	Image 2	Price 2
4	URL 1		Title 3	ID 3	Size 3
5	Image 1		Title 4	ID 4	Size 4	URL 4	Image 4
6	Price 1
7
8	Title 2
9	ID 2
10	Size 2
11	URL 2
12	Image 2
13	Price 2
14
15	Title 3
16	ID 3
17	Size 3
18
19	Title 4
20	ID 4
21	Size 4
22	URL 4
23	Image 4
24
Sheet1

 

[Simon4s]

A slight variation to also consider

Sub Rearrange()
  Dim rA As Range
 
  Application.ScreenUpdating = False
  For Each rA In Columns("A").SpecialCells(xlConstants).Areas
    Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, rA.Rows.Count).Value = Application.Transpose(rA.Value)
  Next rA
  Application.ScreenUpdating = True
End Sub

My sample data and results

Simon4s.xlsm
	A	B	C	D	E	F	G	H	I
1	Title 1
2	ID 1		Title 1	ID 1	Size 1	URL 1	Image 1	Price 1
3	Size 1		Title 2	ID 2	Size 2	URL 2	Image 2	Price 2
4	URL 1		Title 3	ID 3	Size 3
5	Image 1		Title 4	ID 4	Size 4	URL 4	Image 4
6	Price 1
7
8	Title 2
9	ID 2
10	Size 2
11	URL 2
12	Image 2
13	Price 2
14
15	Title 3
16	ID 3
17	Size 3
18
19	Title 4
20	ID 4
21	Size 4
22	URL 4
23	Image 4
24
Sheet1

This solution worked well but I am getting Run-time error '13': Type mismatch after 56 rows were generated. Any idea why?

Thanks!

 

[Simon4s]

This code Transpose Column A to Column D and Next:

Sub Transpose2()
Dim i As Long, Lr1 As Long, Lr As Long, R As String
Lr = Range("A" & Rows.Count).End(xlUp).Row
R = 1
For i = 1 To Lr
Lr1 = Range("A" & i).End(xlDown).Row
Range("A" & i & ":A" & Lr1).Copy
Range("D" & R).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
i = Lr1 + 1
R = R + 1
Next i
End Sub

This is working perfectly!

 

[maabadi]

You're Welcome & Thanks for Feedback.

 

[Peter_SSs]

I am getting Run-time error '13': Type mismatch after 56 rows were generated. Any idea why?

If you click Debug, is the highlighted line the one you have put a break point on in that image?
First thing would be to look at what is in the 56th and 57th blocks of text in column A and see if anything unusual is there.