Hi Howard,

Am Thu, 20 Mar 2014 15:00:24 +0100 schrieb Claus Busch:

is following code that what you want?

if the result is what you want try following code. It is a bit faster.
If not please send me the workbook with the expected result.

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

Application.ScreenUpdating = False
myArr = Range("AE2:AO2001")
For i = LBound(myArr) To UBound(myArr)
myStr = ""
For j = 1 To 11 Step 2
If Len(Replace(myArr(i, j), " ", "")) 0 Then
myStr = myStr & myArr(i, j)
End If
Next
Cells(i + 1, 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