Copy range of data until empty row then repeat

[bob33]

I have one column of data (column A) in blocks of 4 or 5 items, separated by an empty row.
I want to copy the 4 or 5 cells of data and then copy it, and paste it (transposed), into the row of the first data item of that group into the next column (B).

My macro worked until I saw that some of the data groups were 5 rows and not 4.
I can't figure out how to accommodate the instances of 5 vs. 4.
I tried searching for various ideas using isempty or similar but my loops kept getting fouled.

Here is my code that works except that the groups with 5 throws off the pasting.

Sub transposer2()
Dim R, c, d As Integer

R = 1
c = 1

For d = 1 To 500
Range(Cells(R, c), Cells((R + 4), c)).Select
Selection.Copy
Cells(R, 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
R = R + 6
Next d

End Sub

Thanks,
Bob

[AlphaFrog]

Maybe try something like this...

Please Login or Register  to view this content.

[bob33]

Alpha,
Genius!
xlCellTypeConstants was the trick. I learn so much from these forums and thank you and others who give such expert advice gratis.
Best,
Bob

[bob33]

Another issue for the same project:
I've a datasheet with over 800 row: Title, Author, etc... in columns.
Column 2 has Title, col 4 has authors.

Since some Titles are written by multiple authors, there are duplicate rows for each title; only difference being the Author is different.

I want to have each Title on one row, with all authors in one cell (concatenated) (Preferred option) or (Can work with option) in adjacent cells on the same row as Title.
My weak attempt works a bit but not really (goes one cycle then stops due to a logic issue with comparing title1 to title 2 I believe. Not sure how to fix.
It also pastes authors one row off or so; not in same row.

My thanks in advance for any help!

Code:


Sub authorgetter()
Dim lngLastRow As Long
Dim c, r, n, x As Integer
Dim title1, title2 As String

Application.ScreenUpdating = False

r = 2 'start of data rows to check
c = 16 'first column to paste author into
n = 1 'counter
x = 0
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row

For y = 1 To 12 'lngLastRow

title1 = Cells(r, 2).Value 'checks if title is same as next row's title
title2 = Cells(r + 1, 2).Value

If title1 = title2 Then
Cells(r, 4).Select 'selects author's name to copy
Selection.Copy
'MsgBox (r)
ActiveCell.Offset(0 - x, c).Select 'pastes name into column
ActiveSheet.Paste
r = r + 1
n = n + 1
c = c + 1 'pastes name into adjacent columns; needs to be concatenated somehow?
x = x + 1
Else
Cells(r, 4).Select 'selects author's name to copy
Selection.Copy
'MsgBox (r)
ActiveCell.Offset(0 - x, c).Select 'pastes name into column
ActiveSheet.Paste
End If

Next y

Application.ScreenUpdating = True
End Sub