Hi Howard,

Am Thu, 20 Mar 2014 06:14:42 -0700 (PDT) schrieb L. Howard:

I did notice that Column AE2 is blank and the blank repeats every 20 rows. Does not affect the copy that your code does. All the blank rows are copied as 5 short phrases instead of 6. More troubleshooting to do.

is following code that what you want?

Sub CopyToA2()
Dim i As Long, j As Long
Dim myStr As String
Dim myArr As Variant

Application.ScreenUpdating = False
For i = 2 To 2001
myStr = ""
For j = 31 To 41 Step 2
If Len(Replace(Cells(i, j), " ", "")) 0 Then
myStr = myStr & Cells(i, j)
End If
Next
Cells(i, 1) = myStr
Next
myArr = Range("A2:A2001")
Sheets("Sheet2").Range("A2").Resize(rowsize:=UBoun d(myArr)) = myArr
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate SP2 / Windows7 SP1
Office 2007 Ultimate SP3 / 2010 Prodessional